VBAを開発する人のための汎用プロシージャ9選

2024年10月20日 20:52

こちらの記事：個人マクロブック等に保存して利用するVBAの汎用プロシージャで個人マクロブックやアドインにコードを記載して、アクティブブック等に対して利用する汎用プロシージャを紹介しました。

「個人マクロブック等に保存して利用するVBAの汎用プロシージャ」の記事は、開発する人以外にも配布することで、便利に利用していただけます。
※基礎的なマクロの実行方法等は、利用者に最低限、身につけていただく必要はありますが…。

今回の記事は、利用する人というよりも、VBAの開発する人にとって便利なコードを紹介します。（一部は、「個人マクロブック等に保存して利用するVBAの汎用プロシージャ」で紹介している記事と重複します。）
なお、自分が作成したものではないものについては、作成者様のサイトのリンクをご紹介いたしますので、そちらで実際のコードをご確認ください。

1. セル参照のA1形式・R1C1形式の表示を切り替えるマクロ

Excelの表示設定では普段は「A1形式」を利用している方が多数派だと思います。
しかし、VBAの開発を行っているとアルファベットで表記されている列が何列目かを整数で知りたい場合があります。
そういうときには、「R1C1形式」に切り替えするのですが、リボンにマクロを登録してワンタッチでA1形式・R1C1形式を切り替えできるようにしておくと便利です。
【コード】amacoda blog－セル参照のA1形式・R1C1形式の表示を切り替えるマクロ

2. 画面更新や自動計算を停止・再開するマクロ

どんなプロシージャも、高速化のために画面更新や自動計算は停止することが多いと思います。例えば、下記のように。

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行に減らすことができます。

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. 選択範囲のセルのサイズ・位置にマクロボタンを挿入する

選択しているセルのサイズと位置に、マクロボタンのオブジェクトを挿入します。
一つのセルだけではなく、複数セルを選択している場合は、複数セルのサイズでマクロボタンが挿入されます。

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のコードを貼り付けすることができます。

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+スペースで呼び出ししてコードウィンドウへコピーペーストしています。

コードスニペット例１

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

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

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. アクティブブックの標準モジュールをすべてエクスポートする

アクティブブックのすべての標準モジュールをブックと同じフォルダへエクスポートするマクロです。個人マクロブックやアドインにプロシージャを保存して利用する前提です。
マクロ有効ブック内に複数の標準モジュールがある場合に、１つ１つエクスポートするのは面倒なので、一括でエクスポートします。標準モジュールをエクスポートするのは、バックアップ等の目的です。

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.の個人マクロブック版で、個人マクロブックのすべての標準モジュールをダウンロードフォルダへエクスポートするマクロです。個人マクロブックやアドインにプロシージャを保存して利用する前提です。

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等の方法でエクスポートした標準モジュールのバックアップ等を一括で取り込みます。
同じ内容の標準モジュールを利用しているマクロ有効ブックがある場合に、コードを更新したときに、他のマクロ有効ブックにも変更内容を反映させるのに便利です。
（共通の標準モジュールを利用していることが前提です。）

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. アクティブなマクロボタンに表示するテキストを入力するマクロ

マクロボタンのテキストを編集したいことがあるとい思います。
しかし、横方向にウィンドウ枠の固定をしている場合は、マクロボタン内のテキストにカーソルが表示されない、という事象が発生します。

この場合は、テキストをうまく編集しようとしても、カーソルの位置が視認できないため、編集が難しいです。
ウィンドウ枠の固定を解除すれば、カーソルの位置が見えるようになりますが、いちいちウィンドウ枠の固定を解除するのが難しい場合は、
アクティブなマクロボタンのテキストを、インプットボックスに入力したテキストへ変更するマクロです。

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

以上、いかがでしたでしょうか？お役に立てたなら幸いです。

もしよろしければサポートをお願いします。今後の執筆のかてにします。