VBE操作代码总结贴

luqiwe

    可能总结得不一定全,但基本要用到的都可以找到,另对VBE的代码操作可参考wwwbjwww的 ADO+ listview实现工作表数据逐步提示性输入 http://club.excelhome.net/thread-652931-1-1.html

一、增加模块

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

      End if

  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("模块").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("模块").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)表示没有保护

dnbc

找了好久的资料，谢谢共享！{:soso_e179:}

fzkoko

挺好的，谢谢

yarchen

雖然不太懂, 還是很感謝您的努力與分享

klmyyq

挺好的，谢谢

sheet1

这个好，学习了

sunny_8848

好资料，谢谢共享！

忘得快

谢谢楼主分享！

lqgsl

非常有用，谢谢了！

jinbo3535

非常有用，谢谢楼主