- -- VBProject:代码操作代码之常用语句
- 一、增加模块
- 1.增加一个模块,命名为“我的模块”
- ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "我的模块"
- 系统常量vbext_ct_StdModule=1
- 2.增加一个类模块,命名为“我的类”
- ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_ClassModule).Name = "我的类"
- vbext_ct_ClassModule=2
- 3.增加一个窗体,命名为“我的窗体”
- ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm).Name = "我的窗体"
- vbext_ct_MSForm=3
- 二、删除模块
- 1.删除“模块1”
- ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("模块1")
- 2.删除窗体“UserForm1”
- ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("UserForm1")
- 3.删除类模块“类1”
- ThisWorkbook.VBProject.VBComponents.Remove ThisWorkbook.VBProject.VBComponents("类1")
- 4.删除所有的窗体
- Sub RmvForms()
- Dim vbCmp As VBComponent
- For Each vbCmp In ThisWorkbook.VBProject.VBComponents
- If vbCmp.Type = vbext_ct_MSForm Then ThisWorkbook.VBProject.VBComponents.Remove vbCmp
- Next vbCmp
- End Sub
- 相关:
- 工作表和ThisWorkbook的模块类型为vbext_ct_Document=100
- 三、增加代码
- 1.在“模块1”中插入代码
- 如果需要在“Sheet1”、“Thisworkbook”、或“Userform1”中操作,用只需将下面的“模块1”换成相应的名称即可。
- 方法1:
- 在模块的开始增加代码,增加的代码放在公共声明option,全局变量等后面。
- Sub AddCode1()
- ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.AddFromString _
- "sub aTest()" & Chr(10) & _
- "msgbox ""Hello""" & Chr(10) & _
- "end sub"
- End Sub
- 方法2:
- 在模块指定行处增加代码,原代码后移。增加代码不理会和判断插入处代码的内容。当指定行大于最后一行行号时,在最后一行的后面插入。
- Sub AddCode2()
- With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
- .InsertLines 1, "sub aTest()"
- .InsertLines 2, "msgbox ""Hello"""
- .InsertLines 3, "end sub"
- End With
- End Sub
- 相关语句:
- (1)“模块1”中代码总行数:
- ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfLines
- (2)“模块1”中代码公共声明部分的行数:
- ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.CountOfDeclarationLines
- (3)显示“模块1”中第1行起的3行代码内容:
- Sub ShowCodes()
- Dim s$
- s = ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.Lines(1, 3)
- Debug.Print s
- End Sub
- (4)过程aTest的起始行数:
- ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcBodyLine("aTest", vbext_pk_Proc)
- ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcStartLine("aTest", 0)
- 系统常量vbext_pk_Proc=0
- 二者的区别是ProcBodyLine返回sub aTest或Function aTest所在的行号,如果sub前面有空行,ProcStartLine返回空行的行号。
- (5)过程aTest的总行数:
- ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ProcCountLines("aTest", vbext_pk_Proc)
- 2.建立事件过程
- 建立事件过程除了使用上面的代码如下面的AddEventsCode1外,还可以使用CreateEventProc方法,如AddEventsCode2所示。
- 一般方法:
- Sub AddEventsCode1()
- ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString _
- "Private Sub Workbook_Open()" & Chr(13) & _
- "MsgBox ""Hello""" & Chr(13) & _
- "End Sub"
- End Sub
- CreateEventProc方法:
- Sub AddEventsCode2()
- Dim i%
- With ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
- i = .CreateEventProc("SelectionChange", "Worksheet") + 1
- .InsertLines i, "Msgbox ""Hello"""
- End With
- End Sub
- 上面CreateEventProc的两个参数建立的事件过程为Worksheet_SelectionChange,分别是下划线两边的内容。
- 相关:
- 测试是否存在SelectionChange事件
- 下面函数测试模块modulname是否存在过程subname,如果存在,则返回起始行号,否则返回0。
- debug.print hassub("Worksheet_SelectionChange","Sheet1")
- Function HasSub(ByVal subname As String, ByVal modulname As String) As Long
- On Error Resume Next
- Dim i
- i = ThisWorkbook.VBProject.VBComponents(modulname).CodeModule.ProcBodyLine(subname, 0)
- If Err.Number = 35 Then
- Err.Clear
- HasSub = 0
- Else
- HasSub = i
- End If
- End Function
- 如果存在,则返回起始行号,否则返回0。
- 四、删除代码
- 1.删除Sheet1中第2行起的三行代码:
- 如果只删除1行代码,第二个参数可省略。
- Sub DelCodes()
- ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule.DeleteLines 2, 3
- End Sub
- 2.删除“模块1”的所有代码:
- Sub DelCodes()
- With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
- .DeleteLines 1, .CountOfLines
- End With
- End Sub
- 3.删除过程aTest:
- Sub DelCodes()
- With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule
- .DeleteLines .ProcStartLine("aTest", 0), .ProcCountLines("aTest", 0)
- End With
- End Sub
- 4.将“模块1”的第5行代码替换为“x=3”
- ThisWorkbook.VBProject.VBComponents("模块1").CodeModule.ReplaceLine 5, "x=3"
- 五、引用项目
- 1.增加引用
- ThisWorkbook.VBProject.References.AddFromFile "C://Windows//System32//asctrls.ocx"
- 2.取消引用
- ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("ASControls")
- 这里ASControls是引用的名字,即后面的rf.Name。
- 3.显示当前所有引用
- Sub ShowRefs()
- Dim rf As VBIDE.Reference
- For Each rf In ThisWorkbook.VBProject.References
- Debug.Print rf.Name, rf.FullPath
- Next
- End Sub
- 六、信任及密码
- 上面所有操作都基于这样的前题:
- (1)EXCEL已设置:
- 工具(T)-宏(M)-安全性(M)-可靠发行商(T)-勾选了“信任对于VB项目的访问(V)”
- (2)工程没有设置密码
- 如果不能满足它们中的任何一个,代码运行就会出错。因为微软不希望我们对VBProject进行操作,我们无从知道这种操作的直接方法被藏到了什么地方。幸运的是,微软在关起正门的同时,还是为我们留了一道门:SendKeys。借助于这道后门和“错误陷阱”,我们仍可以完成我们所要做的事。
- 下面给出绕开这两道门的示意代码,如果你要运行它们,请记得切回EXCEL主界面,而不是在VBE中直接运行。
- 1.信任对于VB项目的访问
- Sub SetAllowableVbe()
- On Error Resume Next
- Dim Chgset As Boolean
- /'陷阱测试,VBProject.Protection在这儿并无实际的意义
- Debug.Print ThisWorkbook.VBProject.Protection
- If Err.Number = 1004 Then
- Err.Clear
- Application.SendKeys "%TMS%T%V{ENTER}"
- Chgset = True
- DoEvents
- End If
- /'要执行的操作....
- /'.....
- /'操作完成后还原操作前的状态
- If Chgset Then Application.SendKeys "%TMS%T%V{ENTER}"
- End Sub
- 2.操作密码工程
- Sub AllowPass()
- Dim pw$
- pw = "Password"
- If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then
- Application.VBE.CommandBars(1).Controls("工具(T)").Controls("VBAProject 属性(&E)...").Execute
- Application.SendKeys pw & "{ENTER}{ENTER}"
- DoEvents
- End If
- /'要执行的操作….
- /'.....
- End Sub
- Protection属性返回工程的受保护状态,vbext_pp_locked(1)为受保护,vbext_pp_none(0)表示没有保护。
来自 http://club.excelhome.net/TopicOther.asp?t=5&BoardID=2&id=191823