VBA工程:代码操作代码常用语句,向工程自动添加模块,代码等操作!!!

2019-07-22 11:43:45 浏览数 (1)

VBA工程:代码操作代码常用语句,向工程自动添加模块,代码等操作!!!




一、增加模块

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.RemoveThisWorkbook.VBProject.VBComponents("模块1")

2.删除窗体“UserForm1”

ThisWorkbook.VBProject.VBComponents.RemoveThisWorkbook.VBProject.VBComponents("UserForm1")

3.删除类模块“类1”

ThisWorkbook.VBProject.VBComponents.RemoveThisWorkbook.VBProject.VBComponents("类1")

4.删除所有的窗体

Sub RmvForms()

Dim vbCmp As VBComponent

For Each vbCmp InThisWorkbook.VBProject.VBComponents

If vbCmp.Type = vbext_ct_MSForm ThenThisWorkbook.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()

WithThisWorkbook.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所示。

一般方法:

SubAddEventsCode1()

ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule.AddFromString_

"Private Sub Workbook_Open()"& Chr(13) & _

"MsgBox""Hello""" & Chr(13) & _

"End Sub"

End Sub

CreateEventProc方法:

SubAddEventsCode2()

Dim i%

WithThisWorkbook.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.printhassub("Worksheet_SelectionChange","Sheet1")

FunctionHasSub(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.DeleteLines2, 3

End Sub

2.删除“模块1”的所有代码:

Sub DelCodes()

WithThisWorkbook.VBProject.VBComponents("模块1").CodeModule

.DeleteLines 1, .CountOfLines

End With

End Sub

3.删除过程aTest:

Sub DelCodes()

WithThisWorkbook.VBProject.VBComponents("模块1").CodeModule

.DeleteLines.ProcBodyLine("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:WindowsSystem32asctrls.ocx"

2.取消引用

ThisWorkbook.VBProject.References.RemoveThisWorkbook.VBProject.References("ASControls")

这里ASControls是引用的名字,即后面的rf.Name。

3.显示当前所有引用

Sub ShowRefs()

Dim rf As VBIDE.Reference

For Each rf InThisWorkbook.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项目的访问

SubSetAllowableVbe()

OnError 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

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)表示没有保护。

本节内容来自网络!如有侵权请联系删除!



0 人点赞