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