Sub CreateSub()
Dim wk As Workbook
Application.ScreenUpdating = False
strCode = ""
'写入目标模块中的指定VBA代码
strCode = strCode & "Sub test()" & vbCrLf
strCode = strCode & "Msgbox(""hello world!"")" & vbCrLf
strCode = strCode & "End Sub" & vbCrLf
Set wk = Workbooks.Add
Set newmodule = wk.VBProject.VBComponents.Add(1)
'With ActiveWorkbook.VBProject.VBComponents(newmodule.Name).CodeModule
'下面的代码可将code创建于目标模块的原有代码之后
'.InsertLines .CountOfLines + 1, strCode
'End With
newmodule.CodeModule.AddFromString strCode
ActiveWorkbook.Sheets(1).Buttons.Add(200, 100, 60, 30).Select
'插入表单按钮控件
Selection.OnAction = ActiveWorkbook.Name & "!test"
'指定按钮的宏
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\test.xlsm", xlOpenXMLWorkbookMacroEnabled
ActiveWorkbook.Close False
Application.ScreenUpdating = True
MsgBox "已生成包含VBA工程的工作簿:test.xlsm!"
End Sub