いくつかの応用サンプルを紹介します。今までのページで解説していない使い方もあります。
VBEの操作を誤ると、マクロコードを消してしまったり、Module1などのコンポーネントを削除してしまうこともあります。実行には十分注意してください。
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#」に置換します。
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
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