利用VBA代码操作VBE一例

▎具体需求

工作表中存在代码，现在需要把代码写入当前工作表的模块中，并插入按钮，指定按钮触发该程序（循环打开工作簿这个sub过程）。全部都用VBA的方式来实现。

▎代码思路

首先需要新建模块，将代码写入模块，接着需新建按钮，并且把按钮的触发事件代码写入工作表模块。

▎实现代码

Sub 插入代码() '//将工作表中的代码，写入模块 On Error Resume Next '引用Microsoft Visual Basic for Applications Extensibility 5.3，否则会报错 ActiveWorkbook.VBProject.References.AddFromFile Environ$("commonprogramfiles") & "\microsoft shared\VBA\VBA6\VB6EXT.OLB" 'ThisWorkbook.VBProject.References.AddFromFile "D:\Program Files\VB98\VB6EXT.OLB" 'ActiveWorkbook.VBProject.References.AddFromGuid _ "{0002E157-0000-0000-C000-000000000046}", 5, 3 Set VBComp = ActiveWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule) '新增Module1 VBComp.Name = "NewModule" '新增模块的名字叫NewModule For Each Rng In ActiveSheet.Range("A1:A" & ActiveSheet.Cells(Rows.Count, 1).End(3).Row) '将活动sheet中A列的代码，用换行符连接起来，等下整体写入模块中 Code = Code & Rng & vbCrLf Next Rng Set a = ActiveWorkbook.VBProject.VBComponents("NewModule").CodeModule a.InsertLines 1, Code '将代码写入模块 '//插入ActiveX按钮控件，并且设置按钮控件显示的内容是【执行】 Set MyNewbtn = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _ , DisplayAsIcon:=False, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=92.25, Height:=30) MyNewbtn.Name = "MyNewButton" '设置按钮名 MyNewbtn.Object.Caption = "执行" '设置按钮标题 '//向工作表模块写入按钮的代码 Set wmodle = ActiveWorkbook.VBProject.VBComponents.Item("Sheet1").CodeModule wmodle.InsertLines 1, "Private Sub MyNewButton_Click()" wmodle.InsertLines 2, "call 循环打开工作簿" wmodle.InsertLines 3, "End Sub"End Sub

运行之前，需要做一个准备工作：信任对VBA工程对象模型的访问

▎运行结果

▎补充一些对VBE操作的代码

以下代码转载自原文链接：CSDN博主「预见未来to50」的原创文章https://blog.csdn.net/hpdlzu80100/article/details/80835628

  • 添加模块、过程、代码

Sub 添加新模块B() With ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule) .Name = "B" End WithEnd Sub' vbext_ct_ClassModule 将一个类模块添加到集合'     vbext_ct_MSForm 将窗体添加到集合'     vbext_ct_StdModule 将标准模块添加到集合
Sub 添加新过程() Dim sr, code sr = "Sub ABC()" & vbCrLf & "Msgbox ""测试添加代码""" & vbCrLf & "End Sub" With ThisWorkbook.VBProject.VBComponents("B").CodeModule .AddFromString sr End WithEnd Sub
Sub 在B模块中的第3行插入一行代码() With ThisWorkbook.VBProject.VBComponents("B").CodeModule .InsertLines 3, "sheets(1).Select" End WithEnd Sub

  • 添加模块、过程、代码

Sub 删除B模块() With ThisWorkbook.VBProject.VBComponents .Remove ThisWorkbook.VBProject.VBComponents("B") End WithEnd Sub
Sub 删除B模块中的ABC过程() Dim 开始行数, 总行数 With ThisWorkbook.VBProject.VBComponents("B").CodeModule 开始行数 = .ProcBodyLine("ABC", vbext_pk_Proc) 总行数 = .ProcCountLines("ABC", vbext_pk_Proc) .DeleteLines 开始行数, 总行数 End WithEnd Sub

  • 导入、导出和替换一个模块或代码

Sub 导出一个模块() ThisWorkbook.VBProject.VBComponents("A").Export "D:/A.bas"End SubSub 导入一个模块() ThisWorkbook.VBProject.VBComponents.Import "D:/A.bas"End Sub
Sub 替换一个模块() '先删除模块,然后导入新模块 ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("A") ThisWorkbook.VBProject.VBComponents.Import "D:/A.bas"End Sub
Sub 替换A模块的B程序第一行代码() Dim 开始行数 With ThisWorkbook.VBProject.VBComponents("B").CodeModule 开始行数 = .ProcBodyLine("ABC", vbext_pk_Proc) .ReplaceLine 开始行数 + 1, "MsgBox ""修改后""" End WithEnd Sub

  • 模块的查找

'Find(查找内容,开始行数,开始列数,结束行数,结束列数,是否匹配)Sub 在B模块中查找() With ThisWorkbook.VBProject.VBComponents("B").CodeModule MsgBox .Find("我", 1, 1, 1, 1) End WithEnd Sub

  • 其他代码

Sub 给文件添加模块() Dim wb As Workbook, ph As String Application.DisplayAlerts = False ph = ThisWorkbook.Path & "\" Set wb = Workbooks.Open(ph & "test.xls") ThisWorkbook.VBProject.VBComponents("A").Export ph & "A.bas" Windows(wb.Name).Visible = True wb.VBProject.VBComponents.Import ph & "A.bas" wb.Close True Set wb = Nothing Kill ph & "A.bas" Application.DisplayAlerts = TrueEnd Sub
Sub 删除指定文件模块() Dim wb As Workbook, ph As String Application.DisplayAlerts = False ph = ThisWorkbook.Path & "\" Set wb = Workbooks.Open(ph & "test.xls") Windows(wb.Name).Visible = True wb.VBProject.VBComponents.Remove wb.VBProject.VBComponents("A") wb.Close True Set wb = Nothing Application.DisplayAlerts = TrueEnd Sub
Sub 列出引用列表目录()Dim ref, iFor Each ref In ThisWorkbook.VBProject.Referencesi = i + 1 Cells(i, 1) = ref.Name Cells(i, 2) = ref.FullPath Cells(i, 3) = ref.DescriptionNext refEnd Sub
Sub 引用IDE() ThisWorkbook.VBProject.References.AddFromFile "D:\Program Files\VB98\VB6EXT.OLB" '路径根据自己的电脑更新End Sub Sub 添加字典引用() ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\scrrun.dll"End Sub

VBA微信交流群已经到④群，目前准备开设⑤群，需要交流VBA或者函数的朋友可扫码，邀请你进群。

赞 (0)

相关推荐