応用サンプル


いくつかの応用サンプルを紹介します。今までのページで解説していない使い方もあります。

VBEの操作を誤ると、マクロコードを消してしまったり、Module1などのコンポーネントを削除してしまうこともあります。実行には十分注意してください。

  1. アクティブブックの全標準モジュールをエクスポートする
  2. 複数のブックに同じマクロを追加する
  3. 複数ブックのマクロを置換する
  4. Book1のモジュールをBook2にコピーする
  5. UserFormを作成する
  6. 自分自身を削除するマクロ

アクティブブックの全標準モジュールをエクスポートする

Sub Sample1()
    Dim VBC
    Const Path As String = "C:\Work\"
    With ActiveWorkbook.VBProject
        For Each VBC In .VBComponents
            If VBC.Type = 1 And _
               VBC.CodeModule.CountOfDeclarationLines <> VBC.CodeModule.CountOfLines Then
                VBC.Export Path & VBC.Name & ".bas"
            End If
        Next VBC
    End With
End Sub

※アクティブブックに含まれるすべての標準モジュールを、C:\Workフォルダにエクスポートします。標準モジュールに宣言セクションしかなく、コードが記述されていない場合はエクスポートしません。エクスポートするファイル名は「標準モジュール名.bas」です。

複数のブックに同じマクロを追加する

Sub Sample2()
    Dim Target As Workbook, buf As String, VBC, cnt As Long
    Const Path As String = "C:\Tmp\"
    buf = Dir(Path & "*.xls")
    Do While buf <> ""
        Set Target = Workbooks.Open(Path & buf)
        With Target.VBProject
            cnt = 0
            For Each VBC In .VBComponents
                If VBC.Type = 1 Then cnt = cnt + 1
            Next VBC
            If cnt = 0 Then
                .VBComponents.Add 1
                .VBComponents("Module1").CodeModule.AddFromFile "C:\Work\Macro.txt"
            End If
        End With
        Target.Save
        Target.Close
        buf = Dir()
    Loop
End Sub

※C:\Tmpフォルダにあるすべてのブックに対し、もし標準モジュールがなかったら追加し、追加した標準モジュールへC:\Work\Macro.txtに記述しておいたマクロを挿入します。

複数ブックのマクロを置換する

Sub Sample3()
    Dim Target As Workbook, buf As String, VBC, i As Long
    Const Path As String = "C:\Tmp\"
    buf = Dir(Path & "*.xls")
    Do While buf <> ""
        Set Target = Workbooks.Open(Path & buf)
        With Target.VBProject.VBComponents("Module1").CodeModule
            For i = 1 To .CountOfLines
                If .Lines(i, 1) = "    Const StartDay As Date = #4/1/2006#" Then
                    .ReplaceLine i, "    Const StartDay As Date = #9/1/2007#"
                End If
            Next i
        End With
        Target.Save
        Target.Close
        buf = Dir()
    Loop
End Sub

※C:\Tmpフォルダにあるすべてのブックに対し、Module1内に記述されている「Const StartDay As Date = #4/1/2006#」をすべて「Const StartDay As Date = #9/1/2007#」に置換します。

Book1のモジュールをBook2にコピーする

Sub Sample4()
    Dim VBP, Code As String
    With Workbooks("Book1").VBProject.VBComponents("Module1").CodeModule
        Code = .Lines(1, .CountOfLines)
    End With
    With Workbooks("Book2").VBProject.VBComponents.Add(1)
        .CodeModule.AddFromString Code
    End With
End Sub

※Book1にあるModule1をBook2にコピーします。Book1とBook2は、どちらもExcelで開いているとします。モジュールをコピーするメソッドはありませんので、Book1のモジュールにある文字列すべてを、Book2に新しく追加したモジュールにコピーしています。上記のコードは宣言セクションを含んだコードをコピーします。宣言セクション以外のコードをコピーするときは、次のようにします。

Sub Sample4()
    Dim VBP, Code As String
    With Workbooks("Book1").VBProject.VBComponents("Module1").CodeModule
        Code = .Lines(.CountOfDeclarationLines + 1, _
                                      .CountOfLines - .CountOfDeclarationLines + 1)
    End With
    With Workbooks("Book2").VBProject.VBComponents.Add(1)
        .CodeModule.AddFromString Code
    End With
End Sub

UserFormを作成する

Sub Sample5()
    Dim myNewForm, myControl, n As Long
    Set myNewForm = ActiveWorkbook.VBProject.VBComponents.Add(ComponentType:=3)
    With myNewForm
       .Properties("Height") = 180
       .Properties("Width") = 240
       .Properties("Caption") = "ユーザー設定"
    End With
    Set myControl = myNewForm.Designer.Controls.Add("Forms.ListBox.1")
    With myControl
       .Left = 10
       .Top = 10
       .Height = 130
       .Width = 100
    End With
    Set myControl = myNewForm.Designer.Controls.Add("Forms.TextBox.1")
    With myControl
       .Left = 120
       .Top = 10
       .Height = 15
       .Width = 100
    End With
    Set myControl = myNewForm.Designer.Controls.Add("Forms.CheckBox.1")
    With myControl
       .Left = 120
       .Top = 36
       .Caption = "チェック1"
       .AutoSize = True
       .Value = True
    End With
    Set myControl = myNewForm.Designer.Controls.Add("Forms.CommandButton.1")
    With myControl
       .Left = 160
       .Top = 120
       .Height = 18
       .Width = 60
       .Caption = "閉じる"
    End With
    n = myNewForm.CodeModule.CreateEventProc("Click", myControl.Name)
    myNewForm.CodeModule.ReplaceLine n + 1, vbTab & "Unload Me"
End Sub

※下図のようなUserFormを作成します。左の大きいのがListBoxで、右には上からTextBox、CheckBox、CommandButtonです。ついでに、CommandButton1をクリックしたとき、UserFormを閉じるコードも自動的に作成します。

自分自身を削除するマクロ

Sheet1に図のようなボタンが配置してあったとします。

このボタンに[Sheet1]モジュールのSub Sample5を割り当てます。

Sub Sample5()
    ''クリックされたボタンを削除します
    ActiveSheet.Shapes(Application.Caller).Delete
    ''このプロシージャを削除します
    With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .DeleteLines .ProcBodyLine("Sample5", 0), .ProcCountLines("Sample5", 0) - 1
    End With
End Sub

※標準モジュールそのものを削除するのは難しいです。Sheet1などSheetモジュールに記述されたプロシージャを削除するのでしたら、上のように簡単です。おまけで、ブックを開いたときに自動実行されるWorkbook_Openを自動削除するやり方もご紹介します。基本的な考え方は同じです。

Private Sub Workbook_Open()
    MsgBox "これは自動実行マクロで表示しています"
    With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        .DeleteLines .ProcBodyLine("Workbook_Open", 0), .ProcCountLines("Workbook_Open", 0) - 1
    End With
End Sub