こちらの記事：個人マクロブック等に保存して利用するVBAの汎用プロシージャで個人マクロブックやアドインにコードを記載して、アクティブブック等に対して利用する汎用プロシージャを紹介しました。
「個人マクロブック等に保存して利用するVBAの汎用プロシージャ」の記事は、開発する人以外にも配布することで、便利に利用していただけます。
※基礎的なマクロの実行方法等は、利用者に最低限、身につけていただく必要はありますが…。
今回の記事は、利用する人というよりも、VBAの開発する人にとって便利なコードを紹介します。（一部は、「個人マクロブック等に保存して利用するVBAの汎用プロシージャ」で紹介している記事と重複します。）
なお、自分が作成したものではないものについては、作成者様のサイトのリンクをご紹介いたしますので、そちらで実際のコードをご確認ください。
1. セル参照のA1形式・R1C1形式の表示を切り替えるマクロ
Excelの表示設定では普段は「A1形式」を利用している方が多数派だと思います。
しかし、VBAの開発を行っているとアルファベットで表記されている列が何列目かを整数で知りたい場合があります。
そういうときには、「R1C1形式」に切り替えするのですが、リボンにマクロを登録してワンタッチでA1形式・R1C1形式を切り替えできるようにしておくと便利です。
【コード】amacoda blog－セル参照のA1形式・R1C1形式の表示を切り替えるマクロ
2. 画面更新や自動計算を停止・再開するマクロ
どんなプロシージャも、高速化のために画面更新や自動計算は停止することが多いと思います。例えば、下記のように。
コード
ExcelVBA
Sub sbプロシージャ例()
'初期処理
Application.ScreenUpdating = False '画面更新の停止
Application.Calculation = xlCalculationManual '自動計算の停止（手動計算）
Application.DisplayAlerts = False '画面警告の表示の停止
Application.EnableEvents = False 'イベント機能の停止
'メイン処理
'終了処理
Application.ScreenUpdating = True '画面更新の開始
Application.Calculation = xlCalculationAutomatic '自動計算開始
Application.DisplayAlerts = True '画面警告の表示の開始
Application.EnableEvents = True 'イベント機能の開始
End Sub
『初期処理』や『終了処理』等のコメントを記載しないとしても、行数が8行もありコードが長くなる原因になります。
そのため、画面更新の停止や開始等をまとめて設定する下記のようなプロシージャをマクロ有効ブックに保存しておきます。
この汎用プロシージャを利用すれば、メインプロシージャの方で記載する際の行数は8行から2行に減らすことができます。
コード
ExcelVBA
Public Sub sbSetting(flg As Boolean)
If flg Then
Application.ScreenUpdating = False '画面更新の停止
Application.Calculation = xlCalculationManual '自動計算の停止（手動計算）
Application.DisplayAlerts = False '画面警告の表示の停止
Application.EnableEvents = False 'イベント機能の停止
Else
Application.ScreenUpdating = True '画面更新の開始
Application.Calculation = xlCalculationAutomatic '自動計算開始
Application.DisplayAlerts = True '画面警告の表示の開始
Application.EnableEvents = True 'イベント機能の開始
End If
End Sub
Sub sbSettingの使用例()
Call sbSetting(True) '画面更新OFF等の初期設定ON
'メイン処理
Call sbSetting(False) '画面更新OFF等の初期設定OFF
End Sub
よく利用するコードを別のプロシージャに細分化する話は、こちらの記事でもう少し詳しく解説しています。ご興味があればこちらもご一読ください。
3. 選択範囲のセルのサイズ・位置にマクロボタンを挿入する
選択しているセルのサイズと位置に、マクロボタンのオブジェクトを挿入します。
一つのセルだけではなく、複数セルを選択している場合は、複数セルのサイズでマクロボタンが挿入されます。
コード
ExcelVBA
Sub sbマクロボタン作成()
With ActiveSheet.Buttons.Add(Selection.Left, Selection.Top, Selection.Width, Selection.Height)
'.OnAction "sbダミー" '実行されるマクロの指定
.Font.Name = "Meiryo UI"
.Font.Size = 14
.Characters.text = "ボタン"
End With
End Sub
4. Enumをセルの選択範囲から自動作成する
Enumは整数のみを取り扱うことができる定数の集合体です。
Excelのデータにあるヘッダーを範囲選択した状態にして、マクロを実行することで、Enumを自動的に作成するコードです。
マクロを実行後に、Enumのコードがクリップボードに格納されているので、VBE画面でペーストすれば、任意の箇所にEnumのコードを貼り付けすることができます。
コード
ExcelVBA
Sub sb選択範囲よりEnum自動作成しクリップボードへ出力()
'用途：Excelのデータのヘッダーを選択してEnumをクリップボードに出力する
Dim myMsg As String 'メッセージボックス用変数
'enumの名前をmsgboxで入力
Dim enumName As String
enumName = InputBox("enumの名前を入力してください。", "enum作成")
'enumの名前が空白の場合は終了
If enumName = "" Then
MsgBox "enumの名前が入力されませんでした。", vbExclamation, "enum作成"
Exit Sub
End If
'データベースのヘッダーを範囲選択
Dim rng As Range
Set rng = Selection
'列数と行数を取得
Dim colNum As Long
Dim rowNum As Long
colNum = rng.Columns.Count
rowNum = rng.Rows.Count
'選択範囲の最左列を取得
Dim startCol As Long
startCol = rng.Column '選択範囲の左端の列番号
'enumの値をヘッダーから取得
Dim enumValue As String
Dim i As Long
Dim j As Long
Dim k As Long: k = 1
Dim isFirst As Boolean '最初の要素かどうかを判定する変数
enumValue = ""
isFirst = True '最初の要素のフラグをTrueにする
If rowNum > 1 Then GoTo Continue '選択している行が2行の場合には処理中止
For i = 1 To colNum
For j = 1 To rowNum
'空白のセルは無視
If rng.Cells(j, i).Value <> "" Then
'括弧（）などの記号は使用できないため、『_（アンダースコア）』に変換するようにコード改修
'※閉じる方『）』は、空白に置換
Dim cellValue As String
cellValue = rng.Cells(j, i).Value
cellValue = Replace(cellValue, "(", "_")
cellValue = Replace(cellValue, ")", "")
cellValue = Replace(cellValue, "（", "_")
cellValue = Replace(cellValue, "）", "")
cellValue = Replace(cellValue, "【", "_")
cellValue = Replace(cellValue, "】", "")
cellValue = Replace(cellValue, "/", "_")
cellValue = Replace(cellValue, "・", "_")
cellValue = Replace(cellValue, "･", "_")
cellValue = Replace(cellValue, "-", "_")
If isFirst Then '最初の要素の場合は、値の後に「=startCol」を追加する（startColは選択範囲の左端の列数）
enumValue = enumValue & vbTab & cellValue & " =" & startCol & vbNewLine
isFirst = False '最初の要素のフラグをFalseにする
ElseIf i = colNum Then '最終列なら
enumValue = enumValue & vbTab & cellValue & vbNewLine
enumValue = enumValue & vbTab & "[_最終項目]" & vbTab & "'疑似的最終項目" & vbNewLine
enumValue = enumValue & vbTab & "Count = [_最終項目] - 1" & vbNewLine
Else '最初の要素以外の場合
enumValue = enumValue & vbTab & cellValue & vbNewLine
End If
ElseIf rng.Cells(j, i).Value = "" Then '空白の場合はインテリセンスが働かないダミー項目名を追加
enumValue = enumValue & vbTab & "[_dummy_" & k & "]" & vbNewLine
k = k + 1
End If
Next j
Next i
'enumの値の末尾の改行を削除
enumValue = Left(enumValue, Len(enumValue) - 2)
'enumのコードを作成
Dim enumCode As String
enumCode = "Enum ze" & enumName & vbNewLine & enumValue & vbNewLine & "End Enum" & vbNewLine
'enumのコードをクリップボードにセット
sbクリップボードへ文字列セット enumCode
myMsg = "クリップボードにEnumの出力が完了しました。" & vbCrLf + myMsg
MsgBox myMsg, , "処理結果通知"
Exit Sub
Continue: 'GoTo Continueの後はここから処理が行われる
myMsg = "選択行が2行以上のため処理を中止しました。"
MsgBox myMsg, , "処理結果通知"
End Sub
Public Sub sbクリップボードへ文字列セット(ByVal a_text As String)
'クリップボードへ文字列を送信
'必要な参照設定：Microsoft Forms 2.0 Object Library
With CreateObject("Forms.TextBox.1")
.MultiLine = True
.Text = a_text
.SelStart = 0
.SelLength = .TextLength
.Copy
End With
End Sub
より詳しい解説は、下記の記事で行っています。
【コード】ExcelVBAで定数の代わりにEnum使う & Enumの自動作成
5. VBA用のコードスニペット集からテンプレートを呼び出すマクロ
こちらの記事を参考に、コードスニペット集を作成しています。
例えば、下記のようなテンプレートを登録し、呼び出して使いたいときに、イミディエイトウィンドウでSNIまで入力してCTRL+スペースで呼び出ししてコードウィンドウへコピーペーストしています。
コードスニペット例１
ExcelVBA
Sub SNI初回コードテンプレート()
Debug.Print "Sub sbテンプレート()"
Debug.Print "'用途 ：" '用途
Debug.Print "'作成日：" & Format(Now(), "yyyy/mm/dd") '日付
Debug.Print "'作成者：" & Application.username 'Officeのユーザー名を取得
Debug.Print " "
Debug.Print "'***********************************************************************************************************************************************"
Debug.Print " '初期処理"
Debug.Print "'***********************************************************************************************************************************************"
Debug.Print " Call sbSetting(True) '画面更新OFF等の初期設定ON"
Debug.Print " Dim StartTime As Double '開始時間（処理時間計算用）"
Debug.Print " "
Debug.Print "'***********************************************************************************************************************************************"
Debug.Print " '主処理"
Debug.Print "'***********************************************************************************************************************************************"
Debug.Print ""
Debug.Print ""
Debug.Print ""
Debug.Print ""
Debug.Print "'***********************************************************************************************************************************************"
Debug.Print " '終了処理"
Debug.Print "'***********************************************************************************************************************************************"
Debug.Print " Dim EndTime As Double '終了時間（処理時間計算用）"
Debug.Print " Call sbSetting(False) '画面更新OFF等の初期設定OFF"
Debug.Print " Dim myMsg As String 'メッセージボックス用変数"
Debug.Print " myMsg = ""処理が終了しました。"" & vbCrLf"
Debug.Print " myMsg = myMsg + Format(StartTime - EndTime, ""h時間mm分ss秒"") & vbCrLf"
Debug.Print " MsgBox myMsg, , ""処理結果通知"""
Debug.Print ""
Debug.Print "End Sub"
End Sub
コードスニペット例2
ExcelVBA
Sub SNIテストモード()
Debug.Print " 'テストモードを指定"
Debug.Print " Dim isTesting As Boolean"
Debug.Print " isTesting = False"
Debug.Print ""
Debug.Print " If isTesting Then Debug.Print ""テスト"""
End Sub
コードスニペット例3
ExcelVBA
Sub SNI全シートループ()
Debug.Print "Sub sb全シート〇〇()"
Debug.Print " Dim wb As Workbook"
Debug.Print " Dim ws As Worksheet"
Debug.Print " "
Debug.Print " Call sbSetting(True) '画面更新OFF等の初期設定ON"
Debug.Print " "
Debug.Print " ' 現在のアクティブワークブックを取得"
Debug.Print " Set wb = ActiveWorkbook"
Debug.Print " "
Debug.Print " ' 各ワークシートに対してループ"
Debug.Print " For Each ws In wb.Worksheets"
Debug.Print " "
Debug.Print " Next ws"
Debug.Print " "
Debug.Print " Call sbSetting(False) '画面更新OFF等の初期設定OFF"
Debug.Print " "
Debug.Print " Dim myMsg As String 'メッセージボックス用変数"
Debug.Print " myMsg = ""処理が終了しました。"""
Debug.Print " MsgBox myMsg, , ""処理結果通知"""
Debug.Print "End Sub"
End Sub
6. アクティブブックの標準モジュールをすべてエクスポートする
アクティブブックのすべての標準モジュールをブックと同じフォルダへエクスポートするマクロです。個人マクロブックやアドインにプロシージャを保存して利用する前提です。
マクロ有効ブック内に複数の標準モジュールがある場合に、１つ１つエクスポートするのは面倒なので、一括でエクスポートします。標準モジュールをエクスポートするのは、バックアップ等の目的です。
コード
ExcelVBA
Sub sbアクティブブックの標準モジュールをすべて出力()
'※1 エクスポートする前に、Excelの設定で「VBAプロジェクトオブジェクトモデルへのアクセスを信頼する」にチェックを入れる必要がある。
'※2 VBA画面のツールメニューから「Microsoft Visual Basic for Application Extensibility 5.3」に参照設定をする必要がある。
Dim module As vbComponent ' モジュール
Dim moduleFound As Boolean ' 標準モジュールが見つかったフラグ
Dim extension As String ' モジュールの拡張子
Dim sPath As String ' 処理対象ブックのパス
Dim sFilePath As String ' エクスポートファイルパス
Dim TargetBook As Workbook ' 処理対象ブックオブジェクト
' アクティブブックを対象とする
Set TargetBook = ActiveWorkbook
sPath = TargetBook.Path ' 処理対象ブックのパスを取得
'標準モジュールが見つかったかどうかのフラグを初期化
moduleFound = False
' VBAプロジェクトに含まれる全てのモジュールをループ
For Each module In TargetBook.VBProject.VBComponents
' 標準モジュールのみを対象
If module.Type = vbext_ct_StdModule Then
' モジュールの拡張子を設定
extension = ".bas"
' エクスポートファイルパスを設定
sFilePath = sPath & "\" & module.Name & extension
' モジュールをエクスポート
module.Export sFilePath
' 標準モジュールが見つかったフラグを設定
moduleFound = True
End If
Next
' 標準モジュールが見つからなかった場合、メッセージを表示する
If Not moduleFound Then
MsgBox "対象の標準モジュールがありませんでした。", , "処理結果通知"
Else
MsgBox "処理が終了しました。", , "処理結果通知"
End If
End Sub
7. 個人マクロブックの標準モジュールをすべてエクスポートする
6.の個人マクロブック版で、個人マクロブックのすべての標準モジュールをダウンロードフォルダへエクスポートするマクロです。個人マクロブックやアドインにプロシージャを保存して利用する前提です。
コード
ExcelVBA
Sub sb個人マクロブックの全標準モジュール出力()
'個人マクロブックのすべての標準モジュールをダウンロードフォルダへエクスポートする
'※1 エクスポートする前に、Excelの設定で「VBAプロジェクトオブジェクトモデルへのアクセスを信頼する」にチェックを入れる必要がある。
'※2 VBA画面のツールメニューから「Microsoft Visual Basic for Application Extensibility 5.3」に参照設定をする必要がある。
Dim module As vbComponent 'モジュール
Dim extension As String 'モジュールの拡張子
Dim sPath As String '処理対象ブックのパス
Dim sFilePath As String 'エクスポートファイルパス
Dim TargetBook As Workbook '処理対象ブックオブジェクト
' 個人用マクロブックを対象とする
Set TargetBook = ThisWorkbook
'sPath = TargetBook.Path ' 処理対象ブックのパスを取得
sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
sPath = Replace(sPath, "\Desktop", "\Downloads", 1, 1) ' ダウンロードフォルダに変更
sPath = Replace(sPath, "\OneDrive", "", 1, 1) 'OneDriveを利用している場合はそのままだと「C:\Users\dummy\OneDrive\Downloads」となりアクセスできないため
' VBAプロジェクトに含まれる全てのモジュールをループ
For Each module In TargetBook.VBProject.VBComponents
' 標準モジュールのみを対象
If module.Type = vbext_ct_StdModule Then
' モジュールの拡張子を設定
extension = ".bas"
' エクスポートファイルパスを設定
sFilePath = sPath & "\" & module.Name & extension
' モジュールをエクスポート
module.Export sFilePath
End If
Next
MsgBox "処理が終了しました。", , "処理結果通知"
End Sub
8. 標準モジュールを置換するマクロ
例ではアクティブブックで使用する前提で記載していますが、マクロ有効ブックに記載して、ThisWorkbook.Pathで利用することが多いです。
6～7等の方法でエクスポートした標準モジュールのバックアップ等を一括で取り込みます。
同じ内容の標準モジュールを利用しているマクロ有効ブックがある場合に、コードを更新したときに、他のマクロ有効ブックにも変更内容を反映させるのに便利です。
（共通の標準モジュールを利用していることが前提です。）
コード
ExcelVBA
Sub sb標準モジュール一括置換()
'アクティブブックの標準モジュールを、所定フォルダ内から一括で置き換え（元々ない標準モジュールは新規インポート）
'必要な参照設定：「Microsoft Scripting Runtime」（FileSystemObjectを使用するために必要）
Dim fso As Scripting.FileSystemObject
Dim fldr As Scripting.Folder
Dim fl As Scripting.File
Dim targetPath As String
Dim vbProj As Object
Dim vbComp As Object
Dim moduleName As String
'レファレンス設定でMicrosoft Scripting Runtimeを追加
Set fso = New Scripting.FileSystemObject
'入れ替えたい標準モジュールの保存場所★可変箇所★
targetPath = "C:\Users\dummy\Documents\標準モジュールインポート"
'選択したフォルダ内の.BASファイルのみ扱う。
Set fldr = fso.GetFolder(targetPath)
'アクティブブックのVBProjectを取得する。
Set vbProj = ActiveWorkbook.VBProject
'指定したフォルダ内の各.BASファイルについて処理を行う。
For Each fl In fldr.Files
If Right(fl.Name, 4) = ".bas" Then
moduleName = Left(fl.Name, Len(fl.Name) - 4)
'もし既に同じ名前のモジュールが存在するならば、それを削除する。
For Each vbComp In vbProj.VBComponents
If vbComp.Name = moduleName Then
vbProj.VBComponents.Remove vbComp
Exit For
End If
Next vbComp
'新たなモジュールをインポート
vbProj.VBComponents.Import targetPath & "\" & fl.Name
End If
Next fl
Dim myMsg As String 'メッセージボックス用変数
myMsg = "処理が終了しました。"
MsgBox myMsg, , "処理結果通知"
End Sub
9. アクティブなマクロボタンに表示するテキストを入力するマクロ
マクロボタンのテキストを編集したいことがあるとい思います。
しかし、横方向にウィンドウ枠の固定をしている場合は、マクロボタン内のテキストにカーソルが表示されない、という事象が発生します。
この場合は、テキストをうまく編集しようとしても、カーソルの位置が視認できないため、編集が難しいです。
ウィンドウ枠の固定を解除すれば、カーソルの位置が見えるようになりますが、いちいちウィンドウ枠の固定を解除するのが難しい場合は、
アクティブなマクロボタンのテキストを、インプットボックスに入力したテキストへ変更するマクロです。
コード
ExcelVBA
Sub sbマクロボタンへテキスト入力()
'アクティブなマクロボタンのテキストを、インプットボックスに入力したテキストにする
Dim shpRange As ShapeRange
Dim myRange As Shape
If (TypeName(Selection) <> "Button") Then 'マクロボタン判定
MsgBox "選択しているものがマクロボタンではないか、複数選択しています。", , "処理終了通知"
Exit Sub
End If
Dim defaultText As String
defaultText = Selection.Characters.text '元々入力されているテキスト初期値としてセット
Dim zMacroText As Variant '連番を開始するアクティブセルの番号をInputBoxで入力するための変数（キャンセル時にFalseとなるためVariant型）
zMacroText = Application.InputBox( _
PROMPT:="マクロボタンに表示するテキストを入力してください。", _
TITLE:="マクロボタンテキスト入力", _
Default:=defaultText, _
Type:=2)
If TypeName(zMacroText) = "Boolean" Then
MsgBox "マクロ実行をキャンセルします"
Exit Sub
End If
With Selection
'.OnAction "sbダミー" '実行されるマクロの指定
' .Font.Name = "Meiryo UI"
' .Font.Size = 14
.Characters.text = zMacroText
End With
End Sub
以上、いかがでしたでしょうか？お役に立てたなら幸いです。