Sub auto_open()
    Call runtimer '打開文檔時自動運行
End Sub

Sub runtimer()
    Application.OnTime Now + TimeValue("00:00:05"), "saveit" ' Now + TimeValue("00:00:55") 指定在當(dāng)前時間過05秒鐘后調(diào)用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 = "我的模塊"
系統(tǒng)常量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

相關(guān)：

工作表和ThisWorkbook的模塊類型為vbext_ct_Document=100

三、增加代碼

1.在“模塊1”中插入代碼

如果需要在“Sheet1”、“Thisworkbook”、或“Userform1”中操作，用只需將下面的“模塊1”換成相應(yīng)的名稱即可。
方法1：
在模塊的開始增加代碼，增加的代碼放在公共聲明option,全局變量等后面。

Sub AddCode1()
    ThisWorkbook.VBProject.VBComponents("模塊1").CodeModule.AddFromString _
    "sub aTest()" & Chr(10) & _
    "msgbox ""Hello""" & Chr(10) & _
    "end sub"
End Sub

方法2：

在模塊指定行處增加代碼，原代碼后移。增加代碼不理會和判斷插入處代碼的內(nèi)容。當(dāng)指定行大于最后一行行號時，在最后一行的后面插入。

Sub AddCode2()
    With ThisWorkbook.VBProject.VBComponents("模塊1").CodeModule
        .InsertLines 1, "sub aTest()"
        .InsertLines 2, "msgbox ""Hello"""
        .InsertLines 3, "end sub"
    End With
End Sub

相關(guān)語句：

(1)“模塊1”中代碼總行數(shù)：
ThisWorkbook.VBProject.VBComponents("模塊1").CodeModule.CountOfLines
(2)“模塊1”中代碼公共聲明部分的行數(shù)：
ThisWorkbook.VBProject.VBComponents("模塊1").CodeModule.CountOfDeclarationLines
(3)顯示“模塊1”中第1行起的3行代碼內(nèi)容：

Sub ShowCodes()
    Dim s$
    s = ThisWorkbook.VBProject.VBComponents("模塊1").CodeModule.Lines(1, 3)
    Debug.Print s
End Sub

(4)過程aTest的起始行數(shù)：

ThisWorkbook.VBProject.VBComponents("模塊1").CodeModule.ProcBodyLine("aTest", vbext_pk_Proc)
ThisWorkbook.VBProject.VBComponents("模塊1").CodeModule.ProcStartLine("aTest", 0)
系統(tǒng)常量vbext_pk_Proc=0
二者的區(qū)別是ProcBodyLine返回sub aTest或Function aTest所在的行號，如果sub前面有空行，ProcStartLine返回空行的行號。
(5)過程aTest的總行數(shù)：
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的兩個參數(shù)建立的事件過程為Worksheet_SelectionChange，分別是下劃線兩邊的內(nèi)容。

相關(guān)：
測試是否存在SelectionChange事件
下面函數(shù)測試模塊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行代碼，第二個參數(shù)可省略。

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:WindowsSystem32asctrls.ocx"
2．取消引用
ThisWorkbook.VBProject.References.Remove ThisWorkbook.VBProject.References("ASControls")
這里ASControls是引用的名字，即后面的rf.Name。
3．顯示當(dāng)前所有引用

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已設(shè)置：
工具（T）-宏（M）-安全性（M）-可靠發(fā)行商（T）-勾選了“信任對于VB項目的訪問（V）”
（2）工程沒有設(shè)置密碼
如果不能滿足它們中的任何一個，代碼運行就會出錯。因為微軟不希望我們對VBProject進(jìn)行操作，我們無從知道這種操作的直接方法被藏到了什么地方。幸運的是，微軟在關(guān)起正門的同時，還是為我們留了一道門：SendKeys。借助于這道后門和“錯誤陷阱”，我們?nèi)钥梢酝瓿晌覀兯龅氖隆?br />下面給出繞開這兩道門的示意代碼，如果你要運行它們，請記得切回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
    '要執(zhí)行的操作....
    '.....
    '操作完成后還原操作前的狀態(tài)
    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
    '要執(zhí)行的操作….
    '.....
End Sub

Protection屬性返回工程的受保護(hù)狀態(tài)，vbext_pp_locked(1)為受保護(hù),vbext_pp_none(0)表示沒有保護(hù)。

總結(jié)

以上是生活随笔為你收集整理的VBA：用代码操作代码的全部內(nèi)容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。