Colorful Life2010

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

[VBProject:代码操作代码之常用语句 (转)]的回复

Post a Comment~