VBA:用代码操作代码 |
您所在的位置:网站首页 › vba删除模块代码 › VBA:用代码操作代码 |
Sub auto_open()
Call runtimer '打开文档时自动运行
End Sub
Sub runtimer()
Application.OnTime Now + TimeValue("00:00:05"), "saveit" ' Now + TimeValue("00:00:55") 指定在当前时间过05秒钟后调用Saveit 这个过程。
End Sub
Sub SaveIt()
Application.DisplayAlerts = False
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
Application.Quit
'ThisWorkbook.Close False
End Sub
一、增加模块 1.增加一个模块,命名为“我的模块”ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_StdModule).Name = "我的模块"系统常量vbext_ct_StdModule=12.增加一个类模块,命名为“我的类”ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_ClassModule).Name = "我的类"vbext_ct_ClassModule=23.增加一个窗体,命名为“我的窗体”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 Sub2.删除“模块1”的所有代码: Sub DelCodes() With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule .DeleteLines 1, .CountOfLines End With End Sub3.删除过程aTest: Sub DelCodes() With ThisWorkbook.VBProject.VBComponents("模块1").CodeModule .DeleteLines .ProcStartLine("aTest", 0), .ProcCountLines("aTest", 0) End With End Sub4.将“模块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 Sub2.操作密码工程 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 SubProtection属性返回工程的受保护状态,vbext_pp_locked(1)为受保护,vbext_pp_none(0)表示没有保护。
|
今日新闻 |
推荐新闻 |
CopyRight 2018-2019 办公设备维修网 版权所有 豫ICP备15022753号-3 |