Office中國(guó)論壇/Access中國(guó)論壇

標(biāo)題: VBA代碼編程方法詳解 [打印本頁(yè)]
作者: tanhong    時(shí)間: 2010-10-31 14:57
標(biāo)題: VBA代碼編程方法詳解
本帖最后由 tanhong 于 2010-10-31 19:40 編輯

一、前言
　　本文所說(shuō)的VBA代碼編程，即通過(guò)編程方法創(chuàng)建、刪除或編輯VBA工程部件、模塊或代碼程序?qū)ο�，還可以通過(guò)VBA代碼創(chuàng)建新的代碼，以此可以實(shí)現(xiàn)VBA的二次開(kāi)發(fā)。
　　VBA代碼編程，也就是所謂的VBA可擴(kuò)展性。要實(shí)現(xiàn)VBA擴(kuò)展功能，或者說(shuō)實(shí)現(xiàn)對(duì)VBA代碼的編程，我們必須事先完成以下相關(guān)設(shè)置。

1.1 引用VBA擴(kuò)展類(lèi)庫(kù)（Microsoft Visual Basic For Applications Extensibility 5.3）
　　在ACCESS 2003中擴(kuò)展庫(kù)文件為：VBE6EXT.OLB，你可以在VBE（Visual Basic Editor即VB編輯器）窗口，點(diǎn)菜單 [工具] — [引用]，在 [引用對(duì)話框] 中鉤，來(lái)手動(dòng)引用該擴(kuò)展類(lèi)庫(kù)，你也可以通過(guò)代碼實(shí)現(xiàn)對(duì)其的引用。

  2. Dim ref As Reference
  3. '申明引用類(lèi)對(duì)象
  4. On Error Resume Next '避免因重復(fù)引用造成的錯(cuò)誤提示
  5. '通過(guò)擴(kuò)展庫(kù)標(biāo)識(shí)號(hào)，主版本號(hào)，次版本號(hào)完成引用
  6. Set ref = References.AddFromGuid ("{0002E157-0000-0000-C000-000000000046}", 5, 3)
復(fù)制代碼


1.2 需要啟用編程方式訪問(wèn)VBA項(xiàng)目（僅在EXCEL中需設(shè)定）
　　在Excel 2003和更早版中，需設(shè)定允許對(duì)VBA項(xiàng)目的訪問(wèn)，否則將報(bào)錯(cuò)。ACCESS則不需對(duì)該項(xiàng)進(jìn)行設(shè)定。
點(diǎn)選菜單 [工具]（在Excel中，而不是在VBA編輯器中）—[宏]—[安全性]，在 [安全對(duì)話框]中，單擊 [可靠發(fā)行商] 頁(yè)，點(diǎn)選 [信任對(duì)于“Visual Basic項(xiàng)目”的訪問(wèn)] 項(xiàng)（見(jiàn)下圖）
[attach]43952[/attach]
注冊(cè)表鍵值：
HKLM\Software\Microsoft\Office\11.0\Excel\Security\AccessVBOM", 1, "REG_DWORD"
鍵值為：1，則鉤選；0，則取消鉤選
二、VBA的可擴(kuò)展模型對(duì)象簡(jiǎn)介
l Library VBIDE（擴(kuò)展庫(kù)）
路徑：C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB
描述：Microsoft Visual Basic for Applications Extensibility 5.3

l VBE（VB編輯器）
指VB編輯器，為根對(duì)象，其包含所有其它可在 Visual Basic for Applications中表示的對(duì)象和集合。

l VBProject（工程）
VB工程（或稱(chēng)項(xiàng)目）中包含了所有的代碼模塊和部件。VB項(xiàng)目可包含若干個(gè)VB部件對(duì)象。

l VBComponent（部件）
代表包含在工程中的部件對(duì)象，如：類(lèi)模塊或標(biāo)準(zhǔn)模塊。部件（VBComponent） 對(duì)象的 Type屬性：
常數(shù)值描述
Vbext_ct_StdModule1標(biāo)準(zhǔn)模塊
Vbext_ct_ClassModule2類(lèi)模塊
Vbext_ct_MSForm3Microsoft 窗體（非ACCESS類(lèi)窗體）

l CodePane（代碼窗格）
用 CodePane對(duì)象來(lái)操作 CodePane中可視文本的位置或者代碼窗格中顯示的文本選擇。

lCodeModule（代碼模塊）
代碼模塊是VB部件VBA源代碼，可用 CodeModule對(duì)象來(lái)修改（添加、刪除、編輯）與部件相關(guān)聯(lián)的代碼CodePane 或CodeModule內(nèi)程序類(lèi)別 （prockind）常數(shù)：
常數(shù)值描述
vbext_pk_Proc0指定所有過(guò)程除了Property 過(guò)程。
vbext_pk_Let1指定一個(gè)賦值給屬性的過(guò)程。
vbext_pk_Set2指定一個(gè)給對(duì)象設(shè)置引用的過(guò)程。
vbext_pk_Get3指定一個(gè)返回屬性值的過(guò)程。
以上為VBA的可擴(kuò)展模型部分對(duì)象（非全部對(duì)象），其它模型對(duì)象請(qǐng)參閱幫助。
作者: tanhong    時(shí)間: 2010-10-31 14:59
本帖最后由 tanhong 于 2010-10-31 15:02 編輯

三、工程對(duì)象（Project）
　　表示一個(gè)工程。可用 VBProject對(duì)象設(shè)置工程的屬性、訪問(wèn) VBComponents集合以及訪問(wèn) References集合。通常我們會(huì)用ActiveVBProject返回“工程”窗口中選定的工程，但在實(shí)際編程中，無(wú)論此工程是否被顯式地選定，都只有一個(gè)工程是活動(dòng)的。

3.1判斷工程是否鎖定
　　通過(guò)工程Protection屬性，判斷工程鎖定狀態(tài)。工程Protection屬性（只讀），指示工程是否處于保護(hù)狀態(tài)。返回的值為一事先定義好的常量，表示工程的狀態(tài)。
Protection屬性常量：
常數(shù)
值
描述
Vbext_pp_none
0
常量代表指定的工程未被保護(hù)。
vbext_pp_locked
1
常量代表指定的工程是被鎖住。


3.1.1 判斷工程是否鎖定自定義函數(shù)

  2. '函數(shù)功能：判斷工程是否鎖定
  3. Public Function VBProjectlocked (Optional VBProj As VBProject = Nothing) As Boolean
  4.    Dim Proj   As VBProject
  5.    
  6. '如未指定工程，則為當(dāng)前工程
  7.    If VBProj Is Nothing Then
  8.       Set Proj = VBE.ActiveVBProject
  9.    Else
  10.       Set Proj = VBProj
  11.    End If
  12.    
  13. '判斷工程是否鎖定
  14.    If Proj.Protection = vbext_pp_locked Then
  15.       VBProjectlocked = True
  16.    Else
  17.       VBProjectlocked = False
  18.    End If
  19. End Function
復(fù)制代碼


3.1.2調(diào)用自定義函數(shù)，判斷當(dāng)前工程是鎖定示例

  2.   '函數(shù)輸出為真（True），否則當(dāng)前工程鎖定
  3. If VBProjectlocked = True Then
  4.       MsgBox "工程已鎖定"
  5.    Else
  6.       MsgBox "工程未鎖定"
  7.    End If
復(fù)制代碼

3.2 獲得工程名
  1. '獲得當(dāng)前工程名
  2. VBE.ActiveVBProject.Name
復(fù)制代碼


四、部件對(duì)象（VBComponent）
　　代表一個(gè)包含在工程中的部件，例如類(lèi)模塊或標(biāo)準(zhǔn)模塊。使用 VBComponent對(duì)象訪問(wèn)與部件關(guān)聯(lián)的代碼模塊CodeModule或改變部件的屬性設(shè)置。

4.1 添加工程部件
4.1.1向當(dāng)前工程添加部件公用過(guò)程

  2. '***************************************************
  3. '公用過(guò)程：添加模塊或指定名模塊
  4. ' ComponentType部件類(lèi)型（可選參數(shù)），默認(rèn)為標(biāo)準(zhǔn)模塊
  5. ' VBCompName部件名（可選參數(shù)），默認(rèn)不指定部件名
  6. '***************************************************
  7. Public Sub AddVBComponents (Optional ComponentType As vbext_ComponentType=1, _
  8.                           Optional VBCompName As String = "")
  9.    Dim VBProj      As VBProject       '申明工程（項(xiàng)目）對(duì)象
  10.    Dim VBComps    As VBComponents  '申明部件集合
  11.    '設(shè)定為當(dāng)前工程
  12.    Set VBProj = VBE.ActiveVBProject
  13. 設(shè)定為當(dāng)前工程部件集合
  14.    Set VBComps = VBProj.VBComponents
  15.   
  16. '判斷是否指定部件名，未指定則按默認(rèn)名建立指定類(lèi)型部件
  17.    If VBCompName = "" Then
  18.       VBComps.Add (ComponentType)
  19.    Else
  20.       VBComps.Add (ComponentType).Name = VBCompName
  21.    End If
  22. End Sub
復(fù)制代碼


4.1.2調(diào)用自定義過(guò)程，添加標(biāo)準(zhǔn)模塊
  1. '例一：以默認(rèn)名添加標(biāo)準(zhǔn)模塊
  2. Call AddVBComponents
  3. '例二：以指定名“我的模塊”添加標(biāo)準(zhǔn)模塊
  4. Call AddVBComponents(, "我的模塊")
復(fù)制代碼


4.1.3調(diào)用自定義過(guò)程，添加類(lèi)模塊
  1. '例一：以默認(rèn)名添加類(lèi)模塊
  2. Call AddVBComponents（2）

  4. '例二：以指定名“我的類(lèi)模塊”添加標(biāo)準(zhǔn)模塊
  5. Call AddVBComponents(2, "我的類(lèi)模塊")
復(fù)制代碼


4.1.4 調(diào)用自定義過(guò)程，添加（MSForm）窗體
  1. '例一：以默認(rèn)名添加MSForm窗體
  2. Call AddVBComponents（3）

  4. '例二：以指定名“我的窗體”添加MSForm窗體
  5. Call AddVBComponents(3, "我的窗體")
復(fù)制代碼


說(shuō)明：這里窗體是指“Microsoft窗體”，而非ACCESS通常意義所說(shuō)的窗體，ACCESS窗體實(shí)際為ACCESS類(lèi)對(duì)象，你可以通過(guò)CreateForm方法創(chuàng)建一個(gè)ACCESS對(duì)象窗體。
作者: tanhong    時(shí)間: 2010-10-31 15:03
4.2 移除工程中部件
4.2.1 移除當(dāng)前工程部件自定義過(guò)程

  2. '***********************************************
  3. '公用過(guò)程：移除指定部件或刪除某類(lèi)部件
  4. 'ComponentType部件類(lèi)別（可選參數(shù)），默認(rèn)為標(biāo)準(zhǔn)模塊
  5. 'VBCompName部件名（可選參數(shù)），默認(rèn)不指定部件名
  6. '************************************************
  7. Public Sub RemoveVBComponents (Optional VBCompType As vbext_ComponentType, _
  8.                               Optional VBCompName As String = "")
  9.    Dim VBProj     As VBProject      '申明工程對(duì)象
  10.    Dim VBComp   As VBComponent   '申明部件對(duì)象
  11.    Dim VBComps  As VBComponents  '申明部件集合
  12.    '設(shè)定為當(dāng)前工程
  13.    Set VBProj = VBE.ActiveVBProject
  14. '設(shè)定為當(dāng)前工程部件
  15.    Set VBComps = VBProj.VBComponents
  16.    '判斷是否指定部件名，如未指定則刪除所有指定類(lèi)型部件
  17.    If VBCompName <> "" And VBCompType = 0 Then
  18.       VBComps.Remove VBComps (VBCompName)
  19.    Else
  20.       For Each VBComp In VBComps
  21.          If VBComp.Type = VBCompType Then
  22.             VBComps.Remove VBComps (VBComp.Name)
  23.          End If
  24.       Next
  25.    End If
  26. End Sub
復(fù)制代碼

4.2.2　調(diào)用自定義過(guò)程，移除指定類(lèi)型所有部件示例
  1. '移除指定所有類(lèi)模塊
  2. Call RemoveVBComponents（vbext_ct_ClassModule）
復(fù)制代碼


4.2.3  調(diào)用自定義過(guò)程，移除指定名部件示例（無(wú)需指定部件類(lèi)型）
  1. '移除指定名部件，實(shí)例：指定“我的窗體”
  2. Call RemoveVBComponents(, "我的窗體")
復(fù)制代碼


4.3 列舉部件名及類(lèi)型信息
4.3.1　獲得部件類(lèi)型自定義函數(shù)

  2. '------------------------------------------------------------
  3. '函數(shù)功能：根據(jù)所獲取部件類(lèi)型常量值，獲得部件類(lèi)別名
  4. '------------------------------------------------------------
  5. Function ComponentTypeToString (ComponentType As vbext_ComponentType) As String
  6.    Select Case ComponentType
  7.       Case vbext_ct_ClassModule
  8.          ComponentTypeToString = "類(lèi)模塊"
  9.       Case 100
  10.          ComponentTypeToString = "其它"
  11.       Case vbext_ct_MSForm
  12.          ComponentTypeToString = "微軟窗體"
  13.       Case vbext_ct_StdModule
  14.          ComponentTypeToString = "標(biāo)準(zhǔn)模塊"
  15.       Case Else
  16.          ComponentTypeToString = "未知類(lèi): " & CStr(ComponentType)
  17.    End Select
  18. End Function
復(fù)制代碼


4.3.2 獲取工程中所有部件名及類(lèi)型自定義函數(shù)

  2. '-------------------------------------------------------------------
  3. '函數(shù)功能：列出所有部件名及類(lèi)型
  4. '調(diào)    用：ComponentTypeToString 函數(shù)，獲取部件類(lèi)型
  5. '------------------------------------------------------------------
  6. Public Function AllVBComponentsAndType () As String
  7.    Dim VBComp    As VBComponent     '申明工程部件
  8.    Dim VBComps   As VBComponents     '申明部件集合
  9.    Dim strComps    As String             '輸出結(jié)果
  10.    Dim strObjName  As String             '對(duì)象名
  11.    Dim strType      As String             '類(lèi)型名
  12.    
  13.    Set VBComps = VBE.ActiveVBProject.VBComponents
  14.    '遍歷部件集合，將部件名及類(lèi)型值賦值給變量
  15.    For Each VBComp In VBComps
  16.       strObjName = VBComp.Name
  17.       strType = ComponentTypeToString(VBComp.Type)
  18.       '如果為其它類(lèi)型，判斷是ACCESS窗體、報(bào)表或其它對(duì)象
  19.       If strType = "其它" Then
  20.          If InStr(strObjName, "Form") > 0 Then
  21.             strType = "窗體"
  22.          ElseIf InStr(strObjName, "Report") > 0 Then
  23.             strType = "報(bào)表"
  24.          Else
  25.             strType = "其它"
  26.          End If
  27.       End If
  28.       '將獲取的部件名及類(lèi)型逐行輸出
  29.       strComps = strComps & strObjName & Space (12) & strType & vbCrLf
  30.    Next
  31.    AllVBComponentsAndType = strComps   '賦值輸出
  32. End Function
復(fù)制代碼
作者: tanhong    時(shí)間: 2010-10-31 15:04
4.4 判斷部件是否存在
4.4.1判斷部件是否存在自定義函數(shù)

  2. '-----------------------------------------------------------------------
  3. '函數(shù)功能：判斷指定模塊是否存在,存在輸出為T(mén)rue
  4. '-----------------------------------------------------------------------
  5. Public Function VBComponentExists (ByVal VBCompName As String) As Boolean
  6.    Dim VBProj  As VBProject
  7.    On Error Resume Next
  8.    Set VBProj = VBE.ActiveVBProject
  9.    '存在輸出為T(mén)rue，否則為False
  10.    VBComponentExists = CBool(Len(VBProj.VBComponents(VBCompName).Name))
  11. End Function
復(fù)制代碼


4.4.2判斷指定模塊是否存在調(diào)用示例

  2.    If VBComponentExists("模塊1") = False Then
  3.       MsgBox "不存在"
  4.    Else
  5.       MsgBox "存在"
  6.    End If
復(fù)制代碼


4.5 導(dǎo)入部件文件添加部件
4.5.1導(dǎo)入部件自定義過(guò)程

  2. '導(dǎo)入部件文件添加部件
  3. '輸入?yún)?shù)：FileName(字符串變量) 指示欲添加部件的路徑及文件名
  4. Public Sub ImportFilesToVBComps (FileName As String)
  5.    Dim VBProj     As VBProject
  6.    Dim VBComps   As VBComponents
  7.    
  8.    On Error Resume Next
  9.    
  10.    Set VBProj = VBE.ActiveVBProject
  11.    Set VBComps = VBProj.VBComponents
  12.    '導(dǎo)入指定部件文件，添加部件
  13.    VBComps.Import (FileName)
  14. End Sub
復(fù)制代碼

4.5.2導(dǎo)入部件文件示例
  1. '調(diào)用示例：從指定C盤(pán)導(dǎo)入部件文件"模塊1"添加到當(dāng)前工程
  2. Call ImportFilesToVBComps("C:\模塊1")
復(fù)制代碼

說(shuō)明：導(dǎo)入文件部件如與部件重名，不會(huì)覆蓋原部件，而是添加序號(hào)重新命名。

4.6 導(dǎo)出部件為部件文件
4.6.1導(dǎo)出部自定義過(guò)程

  2. '過(guò)程功能：導(dǎo)出部件為部件文件
  3. '輸入?yún)?shù)：FileName(字符串變量) 用來(lái)指定部件輸出為文件的文件名及導(dǎo)出路徑
  4. '           CompsFile(Variant) 可以是部件名或是部件索引，用以指定欲導(dǎo)出部件
  5. Public Sub ExportVBCompsToFiles (CompsFile As Variant, FileName As String)
  6.    Dim VBProj    As VBProject
  7.    Dim VBComps  As VBComponents
  8.    
  9.    On Error Resume Next
  10.    
  11.    Set VBProj = VBE.ActiveVBProject
  12.    Set VBComps = VBProj.VBComponents (CompsFile)
  13.    '導(dǎo)出部件為部件文件
  14.    VBComps.Import (FileName)
  15. End Sub
復(fù)制代碼

4.6.2 導(dǎo)出部件示例
  1. '調(diào)用示例一：指定部件（模塊1）
  2. Call ExportVBCompsToFiles("模塊1","C:\模塊1.bas")

  4. '調(diào)用示例二：通過(guò)部件索引導(dǎo)出部件，實(shí)例中：索引[1]為[Form_窗體1]類(lèi)對(duì)象
  5. Call ExportVBCompsToFiles(1,"C:\ Form_窗體1.cls")
復(fù)制代碼

說(shuō)明：你可以通過(guò)“部件名”或“索引”來(lái)指定需導(dǎo)出部件。

4.6.3 根據(jù)部件類(lèi)型獲得輸出部件文件后綴名

  2. '根據(jù)部件類(lèi)型，確定輸出部件文件后綴名
  3. Public Function GetFileExtension (VBComp As VBIDE.VBComponent) As String
  4.      Select Case VBComp.Type
  5.         Case vbext_ct_ClassModule
  6.             GetFileExtension = ".cls"
  7.         Case vbext_ct_Document
  8.             GetFileExtension = ".cls"
  9.         Case vbext_ct_MSForm
  10.             GetFileExtension = ".frm"
  11.         Case vbext_ct_StdModule
  12.             GetFileExtension = ".bas"
  13.         Case Else
  14.             GetFileExtension = ".bas"
  15.     End Select
  16. End Function
復(fù)制代碼


說(shuō)明：導(dǎo)出文件名要根據(jù)不同部件類(lèi)型，指定后綴名，見(jiàn)下表：
部件對(duì)象
后綴名
描述
ACCESS類(lèi)對(duì)象
cls
通常所說(shuō)的“窗體”或“報(bào)表”對(duì)象等。
類(lèi)模塊
cls
含有類(lèi)定義的模塊。
標(biāo)準(zhǔn)模塊
bas
只包含過(guò)程、類(lèi)型以及數(shù)據(jù)的聲明和定義的模塊。
窗體
frm
指微軟窗體，而非ACCESS類(lèi)對(duì)象窗體。
作者: tanhong    時(shí)間: 2010-10-31 15:04
五、代碼窗格對(duì)象（CodePane）
　　代碼窗口中包含的代碼窗格。代碼窗口被用來(lái)輸入和編輯代碼。代碼窗口可含有多個(gè)代碼窗格。用 CodePane對(duì)象來(lái)操作 CodePane中代碼或選取的代碼或文本。

5.1 顯示代碼窗格
5.1.1顯示當(dāng)前代碼窗格
  1. '打開(kāi)并顯示當(dāng)前代碼窗格
  2. Public Sub ShowProject ()
  3. 　VBE.ActiveCodePane.Show
  4. End Sub
復(fù)制代碼


5.1.2顯示指定部件代碼模塊窗格

  2. '函數(shù)功能：打開(kāi)指定部件代碼模塊窗格
  3. Public Sub ShowComponent (ByVal CompsNameOrIndex As Variant)
  4.    Dim VBProj       As VBProject        '工程項(xiàng)目對(duì)象
  5.    Dim VBComp      As VBComponent    '組件對(duì)象
  6.    Dim CodeMod     As CodeModule      '代碼模塊
  7.    Dim VBCodePane   As CodePane        '窗格對(duì)象
  8.    
  9.    '實(shí)例化對(duì)象
  10.    Set VBProj = VBE.ActiveVBProject
  11.    Set VBComp = VBProj.VBComponents (CompsNameOrIndex)
  12.    Set CodeMod = VBComp.CodeModule
  13.    Set VBCodePane = CodeMod.CodePane
  14.    
  15.    VBCodePane.Show    '顯示代碼窗格
  16. End Sub
復(fù)制代碼



5.2 獲取窗格所選代碼行列信息
5.2.1獲取當(dāng)前窗格中所選代碼起止行列信息

  2. '所選代碼的起止行列信息定義數(shù)據(jù)類(lèi)型
  3. Public Type SelLineColInfo
  4.    SLine  As Long        '起始行
  5.    SCol   As Long        '起始列
  6.    ELine  As Long        '結(jié)束行
  7.    ECol   As Long        '結(jié)束列
  8. End Type

  10. '-----------------------------------------------------------------------
  11. '函數(shù)功能：獲得所選代碼開(kāi)始行列及結(jié)束行列信息
  12. Public Function VBGetSelection () As SelLineColInfo
  13.    Dim SelInfo  As SelLineColInfo  '數(shù)據(jù)類(lèi)型
  14.    
  15.    VBE.ActiveCodePane.GetSelection SelInfo.SLine, SelInfo.SCol, _
  16.                                 SelInfo.ELine, SelInfo.ECol
  17.    '獲取的行列信息輸出
  18.    VBGetSelection = SelInfo
  19. End Function


  22. '***************************************************
  23. '調(diào)用示例：在窗格中任選一處代碼行列，再運(yùn)行以下代碼
  24. Dim SelInfo As SelLineColInfo '申明自定數(shù)據(jù)類(lèi)型
  25. '起止行列信息賦值給變量   
  26. SelInfo = VBGetSelection
  27. '輸出顯示   
  28. MsgBox "起始行：" & SelInfo.SLine & vbLf & _
  29.        "起始列：" & SelInfo.SCol & vbLf & _
  30.        "結(jié)束行：" & SelInfo.ELine & vbLf & _
  31.        "結(jié)束列：" & SelInfo.ECol
復(fù)制代碼
作者: tanhong    時(shí)間: 2010-10-31 15:05
六、代碼模塊對(duì)象（CodeModule）

　　在諸如窗體，類(lèi)或文檔等部件之后表示程序代碼。可用 CodeModule對(duì)象來(lái)修改（添加、刪除、編輯）與部件相關(guān)聯(lián)的代碼。
　　每個(gè)部件都與一個(gè) CodeModule對(duì)象相關(guān)聯(lián)。但是，一個(gè) CodeModule對(duì)象可以與多個(gè)代碼窗格CodePane相關(guān)聯(lián)。

6.1 獲得指定行代碼
6.1.1 獲得指定模塊中指定一行或多行代碼

  2. '函數(shù)功能：指定模塊指定行代碼
  3. '輸入?yún)?shù)：CompsNameOrIndex 部件名或索引
  4. '          CodeLine(長(zhǎng)整)代碼所在行
  5. '          CountLines(長(zhǎng)整)可選參數(shù)，選取代碼行數(shù),默認(rèn)為1行
  6. Public Function LineCodeString (ByVal CompsNameOrIndex, _
  7.                       ByVal CodeLine As Long, _
  8.                       Optional CountLines As Long = 1) As String
  9.    Dim VBProj      As VBProject
  10.    Dim VBComp     As VBComponent
  11.    Dim CodeMod    As CodeModule
  12.    
  13.    Set VBProj = VBE.ActiveVBProject
  14.    Set VBComp = VBProj.VBComponents (CompsNameOrIndex)
  15.    Set CodeMod = VBComp.CodeModule
  16.    
  17.    LineCodeString = CodeMod.Lines (CodeLine, CountLines)
  18. End Function

  20. '***********************************************
  21. '調(diào)用示例一：獲得“模塊1”，第五行代碼
  22. Debug.Print LineCodeString("模塊1",5)

  24. '***********************************************
  25. '調(diào)用示例二：獲得“模塊1”，第一行至第六行代碼
  26. Debug.Print LineCodeString("模塊1",1 ,6)
復(fù)制代碼


6.2 列舉模塊中所有過(guò)程及類(lèi)型
6.2.1獲得過(guò)程種類(lèi)自定義函數(shù)

  2. ' 函數(shù)功能：獲得過(guò)程種類(lèi)名
  3. ' 輸入?yún)?shù)：ProcKind（過(guò)程類(lèi)型常數(shù)）
  4. Public Function ProcKindString(ByVal ProcKind As vbext_ProcKind) As String
  5.    Select Case ProcKind
  6.       Case vbext_pk_Get
  7.          ProcKindString = "roperty Get"
  8.       Case vbext_pk_Let
  9.          ProcKindString = "roperty Let"
  10.       Case vbext_pk_Set
  11.          ProcKindString = "roperty Set"
  12.       Case vbext_pk_Proc
  13.          ProcKindString = "Sub Or Function"
  14.       Case Else
  15.          ProcKindString = "Unknown Type: " & CStr(ProcKind)
  16.    End Select
  17. End Function
復(fù)制代碼


6.2.2 獲得指定部件中過(guò)程名及類(lèi)型

  2. '---------------------------------------------------------------------
  3. '函數(shù)功能：列出指定模塊中所有過(guò)程
  4. '輸入?yún)?shù)：CompsNameOrIndex 部件名或索引
  5. '調(diào)    用：自定義ProcKindString函數(shù)
  6. '---------------------------------------------------------------------
  7. Public Function ListProcedures (CompsNameOrIndex As Variant) As String
  8.    Dim VBProj     As VBProject            '工程
  9.    Dim VBComp    As VBComponent        '部件
  10.    Dim CodeMod    As CodeModule         '代碼模塊
  11.    Dim ProcKind    As vbext_ProcKind       '過(guò)程類(lèi)型
  12.    Dim LineNum    As Long                '代碼行
  13.    Dim sProcKind   As String                '過(guò)程類(lèi)型名
  14.    Dim ProcName   As String                '過(guò)程名
  15.    
  16.    '實(shí)例化當(dāng)前活動(dòng)的工程
  17.    Set VBProj = VBE.ActiveVBProject
  18.    '實(shí)例化工程對(duì)象集合
  19.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  20.    '實(shí)例化代碼模塊
  21.    Set CodeMod = VBComp.CodeModule
  22.    
  23.    With CodeMod
  24.       '獲得代碼所在起始行,等于申明行加一
  25.       LineNum = .CountOfDeclarationLines + 1
  26.       '獲得指定行所在過(guò)程名
  27.       ProcName = .ProcOfLine(LineNum, ProcKind)
  28.       '申明后第一行開(kāi)始循環(huán)至代碼結(jié)束,將獲取過(guò)程名及類(lèi)型名輸出
  29.       Do Until LineNum >= .CountOfLines
  30.          sProcKind = sProcKind & ProcName & Space(3) & _
  31. ProcKindString(ProcKind) & vbLf
  32.          '代碼行數(shù)累加, 將根據(jù)所在行獲得過(guò)程名
  33.          LineNum = LineNum + .ProcCountLines(ProcName, ProcKind)
  34.          ProcName = .ProcOfLine(LineNum, ProcKind)
  35.       Loop
  36.    End With
  37.    
  38.    ListProcedures = sProcKind
  39. End Function

  41. '***********************************************
  42. '調(diào)用示例：獲取"Form_窗體1"中所有過(guò)程名及類(lèi)型
  43. Debug.Print ListProcedures ("Form_窗體1")
復(fù)制代碼
作者: tanhong    時(shí)間: 2010-10-31 15:05
6.3 判斷過(guò)程是否存在
6.3.1 判斷指定過(guò)程是否存在自定義函數(shù)

  2. '函數(shù)功能：判斷指定過(guò)程是否存在,存在輸出為真
  3. Public Function VBProcExists(ByVal VBProcName As String, _
  4.                          Optional VBCompNameOrIndex As Variant) As Boolean
  5.    Dim VBProj           As VBProject
  6.    Dim VBCodeModule    As CodeModule
  7.    Dim ProcKind         As vbext_ProcKind        '過(guò)程類(lèi)型
  8.    Dim LineNum         As Long                 '代碼行
  9.    Dim ProcName        As String                 '獲得過(guò)程名
  10.    
  11.    Set VBProj = VBE.ActiveVBProject
  12.    '如不指定部件及為當(dāng)前窗格代碼模塊
  13.    If VBCompNameOrIndex = "" Then
  14.       Set VBCodeModule = VBE.ActiveCodePane.CodeModule
  15.    Else
  16.       Set VBCodeModule = VBProj.VBComponents(VBCompNameOrIndex).CodeModule
  17.    End If
  18.    
  19.    With VBCodeModule
  20.       '獲得代碼所在起始行,等于申明行加一
  21.       LineNum = .CountOfDeclarationLines + 1
  22.       '獲得指定行所在過(guò)程名
  23.       ProcName = .ProcOfLine (LineNum, ProcKind)
  24.       '申明后第一行開(kāi)始循環(huán)至代碼結(jié)束,將獲取過(guò)程名及類(lèi)型名輸出
  25.       Do Until LineNum >= .CountOfLines
  26.          '代碼行數(shù)累加,將根據(jù)所在行獲得過(guò)程名
  27.          LineNum = LineNum + .ProcCountLines (ProcName, ProcKind)
  28.          ProcName = .ProcOfLine (LineNum, ProcKind)
  29.          '進(jìn)行二進(jìn)制比對(duì),比對(duì)結(jié)果等一，則存在
  30.          If StrComp (VBProcName, ProcName) = 1 Then
  31.             VBProcExists = True
  32.             Exit Do
  33.          End If
  34.       Loop
  35.    End With
  36. End Function
復(fù)制代碼

6.3.2 調(diào)用自定義函數(shù)示例
  1. '示例一：指定過(guò)程名，但不指定部件
  2. Debug.Print VBProcExists("過(guò)程名")

  4. '示例二：指定過(guò)程名"ShowProcedureInfo"，并指定部件名
  5. Debug.Print VBProcExists("過(guò)程名","部件名")

  7. '示例三：指定過(guò)程名，并通過(guò)索引指定部件
  8. Debug.Print VBProcExists("過(guò)程名",3)
復(fù)制代碼



6.4 獲得指定行所在過(guò)程名
6.4.1 獲得指定行過(guò)程名自定義函數(shù)

  2. '---------------------------------------------------------------------
  3. '函數(shù)功能：獲得指定行過(guò)程名
  4. '---------------------------------------------------------------------
  5. Public Function GetLineProcName (ByVal LineNum As Long) As String
  6.    Dim CodeMod    As CodeModule          '申明代碼模塊
  7.    Dim VBpane     As VBIDE.CodePane      '代碼模塊所在窗格   
  8.    Dim NumLines   As Long                 '代碼行數(shù)
  9.    Dim ProcName   As String                 '過(guò)程名
  10.    Dim ProcKind    As vbext_ProcKind        '過(guò)程類(lèi)型
  11.    
  12.    '實(shí)例化為當(dāng)前代碼窗口
  13.    Set VBpane = VBE.ActiveCodePane
  14.    '實(shí)例化為當(dāng)前窗格代碼模塊
  15.    Set CodeMod = VBpane.CodeModule
  16.    
  17.    With CodeMod
  18.       '獲得代碼起始行行數(shù)
  19.       NumLines = .CountOfDeclarationLines + 1
  20.       '判斷是否為申明代碼行
  21.       If LineNum > NumLines Then
  22.          ProcName = .ProcOfLine (LineNum, ProcKind)
  23.       Else
  24.          GetLineProcName = -1   '如為申明代碼行，則輸出為負(fù)1
  25.          Exit Function
  26.       End If
  27.    End With
  28.    '過(guò)程名輸出
  29.    GetLineProcName = ProcName
  30. End Function
復(fù)制代碼

6.4.2調(diào)用指定行過(guò)程名函數(shù)示例
  1. '獲得指當(dāng)前代碼窗口行號(hào)第26行代碼所在過(guò)程名
  2. Call GetLineProcName(26)
復(fù)制代碼


作者: tanhong    時(shí)間: 2010-10-31 15:06
6.5 獲取過(guò)程代碼行數(shù)信息
6.5.1指定過(guò)程總代碼行數(shù)

  2. '函數(shù)功能：獲得指定過(guò)程總的代碼行數(shù)(含過(guò)程中的所有空行及注釋)
  3. Public Function TotalCodeLinesInProc(CompsNameOrIndex, _
  4.                   strProcName As String, _
  5.                   Optional ProcKind As vbext_ProcKind = 0) As Long
  6.    Dim VBProj       As VBProject        '工程對(duì)象
  7.    Dim VBComp     As VBComponent     '部件對(duì)象
  8.    Dim CodeMod     As CodeModule      '代碼模塊
  9.    
  10.    '設(shè)定為當(dāng)前工程
  11.    Set VBProj = VBE.ActiveVBProject
  12.    '設(shè)定為指定部件
  13.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  14.    '設(shè)定為指定部件代碼模塊
  15.    Set CodeMod = VBComp.CodeModule
  16.    '過(guò)程計(jì)數(shù)輸出
  17.    TotalCodeLinesInProc = CodeMod.ProcCountLines(strProcName, ProcKind)
  18. End Function

  20. '******************************************************************
  21. '調(diào)用示例：獲得部件"bas_ProcInfo"模塊中，"ShowProcedureInfo"過(guò)程總行數(shù)
  22. Debug.Print TotalCodeLinesInProc("bas_ProcInfo", "ShowProcedureInfo")
復(fù)制代碼


6.5.2 指定過(guò)程代碼起始行數(shù)

  2. '函數(shù)功能：獲得指定過(guò)程代碼起始行(從過(guò)程之上的空行和注釋計(jì)算)
  3. Public Function StartLineInProc (CompsNameOrIndex, _
  4.                   strProcName As String, _
  5.                   Optional ProcKind As vbext_ProcKind = 0) As Long
  6.    Dim VBProj     As VBProject
  7.    Dim VBComp    As VBComponent
  8.    Dim CodeMod   As CodeModule
  9.    
  10.    Set VBProj = VBE.ActiveVBProject
  11.    Set VBComp = VBProj.VBComponents (CompsNameOrIndex)
  12.    Set CodeMod = VBComp.CodeModule
  13.    
  14.    StartLineInProc = CodeMod.ProcStartLine(strProcName, ProcKind)
  15. End Function

  17. '******************************************************************
  18. '調(diào)用示例：獲得部件"bas_ProcInfo"模塊中，"ShowProcedureInfo"過(guò)程起始行號(hào)
  19. Debug.Print StartLineInProc ("bas_ProcInfo", "ShowProcedureInfo")
復(fù)制代碼


6.5.3 指定過(guò)程實(shí)際代碼起始行數(shù)

  2. '函數(shù)功能：獲得過(guò)程第一行代碼行(從過(guò)程的實(shí)際代碼行計(jì)算,不含過(guò)程之上空行和注釋)
  3. Public Function CodeBodyLineInProc (CompsNameOrIndex, _
  4.                   strProcName As String, _
  5.                   Optional ProcKind As vbext_ProcKind = 0) As Long
  6.    Dim VBProj      As VBProject
  7.    Dim VBComp    As VBComponent
  8.    Dim CodeMod    As CodeModule
  9.    
  10.    Set VBProj = VBE.ActiveVBProject
  11.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  12.    Set CodeMod = VBComp.CodeModule
  13.    
  14.    CodeBodyLineInProc = CodeMod.ProcBodyLine(strProcName, ProcKind)
  15. End Function

  17. '******************************************************************
  18. '調(diào)用示例：獲得部件"bas_ProcInfo"模塊中，"ShowProcedureInfo"過(guò)程實(shí)際起始行號(hào)
  19. Debug.Print CodeBodyLineInProc ("bas_ProcInfo", "ShowProcedureInfo")
復(fù)制代碼

6.5.4 指定過(guò)程實(shí)際代碼行數(shù)

  2. '函數(shù)功能：獲得指定過(guò)程實(shí)際代碼行數(shù)(不包含空行和注釋行)
  3. Public Function CodeLinesInProc(ByVal CompsNameOrIndex, _
  4.                   ByVal strProcName As String, _
  5.                   Optional ProcKind As vbext_ProcKind = 0) As Long
  6.    Dim VBProj    As VBProject
  7.    Dim VBComp   As VBComponent
  8.    Dim CodeMod  As CodeModule
  9.    
  10.    Dim ProcStart   As Long         '代碼起始行
  11.    Dim ProcTotal   As Long         '代碼總行數(shù)
  12.    Dim I          As Integer        '循環(huán)變量
  13.    Dim strCode    As String         '代碼
  14.    Dim LineCount  As Long         '行計(jì)數(shù)變量
  15.    實(shí)例化對(duì)象
  16.    Set VBProj = VBE.ActiveVBProject
  17.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  18.    Set CodeMod = VBComp.CodeModule
  19.    '獲取開(kāi)始行號(hào)和總行數(shù)
  20.    ProcStart = CodeMod.ProcStartLine (strProcName, ProcKind)
  21.    ProcTotal = CodeMod.ProcCountLines(strProcName, ProcKind) + ProcStart
  22.    
  23.    For I = ProcStart To ProcTotal
  24.       '將代碼賦值給字符串變量
  25.       strCode = CodeMod.Lines(I, 1)
  26.       '跳過(guò)空行和注釋行
  27.       If Trim (strCode) = vbNullString Or Left (Trim (strCode), 1) = Chr (39) Then
  28.       Else
  29.    LineCount = LineCount + 1
  30.       End If
  31.    Next I
  32.    '實(shí)際行數(shù)輸出
  33.    CodeLinesInProc = LineCount
  34. End Function

  36. '******************************************************************
  37. '調(diào)用示例：獲得部件"bas_ProcInfo"模塊中，"ShowProcedureInfo"過(guò)程實(shí)際行數(shù)
  38. Debug.Print CodeLinesInProc ("bas_ProcInfo", "ShowProcedureInfo")
復(fù)制代碼
作者: tanhong    時(shí)間: 2010-10-31 15:06
6.6 獲取部件或模塊中代碼行信息
6.6.1 獲取部件或模塊中申明部分行數(shù)

  2. '函數(shù)功能：獲得指定部件或模塊中申明部分總代碼行數(shù)(含注釋行及空行)
  3. Public Function TotalDeclLinesInVBComp (CompsNameOrIndex) As Long
  4.    Dim VBProj      As VBProject         '申明工程項(xiàng)目對(duì)象
  5.    Dim VBComp    As VBComponent      '申明項(xiàng)目組件對(duì)象
  6.    Dim CodeMod    As CodeModule       '申明組件代碼
  7.    
  8.    '實(shí)例化對(duì)象
  9.    Set VBProj = VBE.ActiveVBProject
  10.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  11.    Set CodeMod = VBComp.CodeModule
  12.    
  13.    '獲得申明代碼行數(shù)并輸出
  14.    TotalDeclLinesInVBComp = CodeMod.CountOfDeclarationLines
  15. End Function

  17. '******************************************************************
  18. '調(diào)用示例：獲得部件"bas_ProcInfo"模塊中申明部分總代碼行數(shù)
  19. Debug.Print TotalDeclLinesInVBComp ("bas_ProcInfo")
復(fù)制代碼


6.6.2 獲得指定模塊中總代碼行數(shù)

  2. '函數(shù)功能：獲得指定模塊中總代碼行數(shù)(含申明代碼行、注釋行及空行)
  3. Public Function TotalCodeLinesInVBComp (CompsNameOrIndex) As Long
  4.    Dim VBProj     As VBProject
  5.    Dim VBComp   As VBComponent
  6.    Dim CodeMod   As CodeModule
  7.    
  8. '實(shí)例化對(duì)象
  9.    Set VBProj = VBE.ActiveVBProject
  10.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  11.    Set CodeMod = VBComp.CodeModule
  12.   
  13. '獲得部件或模塊中代碼總行數(shù)并輸出
  14.    TotalCodeLinesInVBComp = CodeMod.CountOfLines
  15. End Function

  17. '******************************************************************
  18. '調(diào)用示例：獲得部件"bas_ProcInfo"模塊中總代碼行數(shù)
  19. Debug.Print TotalCodeLinesInVBComp ("bas_ProcInfo")

復(fù)制代碼



6.6.3 獲得指定部件或模塊中實(shí)際代碼行數(shù)

  2. '函數(shù)功能：獲得指定部件或模塊代碼數(shù)。包括申明及代碼，但不含注釋代碼行及空白行
  3. Public Function CodeLinesInVBComp (CompsNameOrIndex) As Long
  4.    Dim VBProj     As VBProject
  5.    Dim VBComp   As VBComponent
  6.    Dim CodeMod   As CodeModule
  7.    Dim I          As Long
  8.    Dim strCode    As String
  9.    Dim LineCount  As Long
  10.    
  11.    '實(shí)例化對(duì)象
  12.    Set VBProj = VBE.ActiveVBProject
  13.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  14.    Set CodeMod = VBComp.CodeModule
  15.    
  16.    With CodeMod
  17.       '循環(huán)每行代碼
  18.       For I = 1 To .CountOfLines
  19.          '將代碼賦值給字符串變量
  20.          strCode = .Lines(I, 1)
  21.          If Trim (strCode) = vbNullString Or Left (Trim (strCode), 1) = Chr (39) Then
  22.            '跳過(guò)空行注釋行
  23.          Else
  24.             LineCount = LineCount + 1
  25.          End If
  26.       Next I
  27.    End With
  28.    '獲取實(shí)際代碼計(jì)數(shù)輸出
  29.    CodeLinesInVBComp = LineCount
  30. End Function

  32. '******************************************************************
  33. '調(diào)用示例：獲得部件"bas_ProcInfo"模塊中實(shí)際代碼行數(shù)
  34. Debug.Print CodeLinesInVBComp ("bas_ProcInfo")
復(fù)制代碼


6.7 獲取工程代碼行數(shù)信息
6.7.1工程總代碼行數(shù)

  2. '函數(shù)功能：工程總代碼行數(shù)(含空及注釋)
  3. '調(diào)    用：TotalCodeLinesInVBComp
  4. Public Function TotalCodeLinesInProject () As Long
  5.    Dim VBProj      As VBProject
  6.    Dim VBComp    As VBComponent
  7.    Dim LineCount   As Long
  8.    
  9.    Set VBProj = VBE.ActiveVBProject
  10.    
  11.    '判斷工程是否鎖定，則退出函數(shù),
  12.    If VBProj.Protection = vbext_pp_locked Then
  13.       TotalCodeLinesInProject = -1
  14.       Exit Function
  15.    End If
  16.    
  17.    '遍歷當(dāng)前工程中所有部件
  18.    For Each VBComp In VBProj.VBComponents
  19.       LineCount = LineCount + TotalCodeLinesInVBComp(VBComp.Name)
  20.    Next VBComp

  22.    TotalCodeLinesInProject = LineCount
  23. End Function
復(fù)制代碼

6.7.2工程實(shí)際代碼行數(shù)

  2. '函數(shù)功能：工程實(shí)際代碼行數(shù)(不含空及注釋)
  3. '調(diào)    用：CodeLinesInVBComp
  4. Public Function CodeLinesInProject() As Long
  5.    Dim VBProj      As VBProject
  6.    Dim VBComp     As VBComponent
  7.    Dim LineCount    As Long
  8.    
  9.    Set VBProj = VBE.ActiveVBProject
  10.    
  11.    '遍歷當(dāng)前工程中所有部件對(duì)象
  12.    For Each VBComp In VBProj.VBComponents
  13.       LineCount = LineCount + CodeLinesInVBComp(VBComp.Name)
  14.    Next VBComp
  15.    
  16.    CodeLinesInProject = LineCount
  17. End Function
復(fù)制代碼
作者: tanhong    時(shí)間: 2010-10-31 15:07
6.8 代碼模塊中添加代碼操作
6.8.1 向指定部件添加一行代碼

  2. '過(guò)程功能：向指定部件或模塊添加代碼
  3. '輸入?yún)?shù)：strNewCode（字符串）添加的代碼字符串
  4. '          VBCompNameOrIndex(Variant)可選參數(shù)，部件名或索引
  5. Sub AddNewCodeInComps (ByVal strNewCode As String, _
  6.                       Optional VBCompNameOrIndex As Variant)
  7.    Dim VBProj          As VBProject
  8.    Dim VBCodeModule   As CodeModule
  9.    
  10.    Set VBProj = VBE.ActiveVBProject
  11.    
  12.    '如不指定部件或模塊，及為當(dāng)前窗格部件代碼模塊
  13.    If VBCompNameOrIndex = "" Then
  14.       Set VBCodeModule = VBE.ActiveCodePane.CodeModule
  15.    Else
  16.       Set VBCodeModule = VBProj.VBComponents(VBCompNameOrIndex).CodeModule
  17.    End If
  18.    '向模塊中添加新代碼
  19.    VBCodeModule.AddFromString strNewCode
  20. End Sub


  23. '*********************************************************
  24. '調(diào)用示例：向指定部件“模塊1”，添加代碼
  25. Dim strNewCode  As String
  26. strNewCode = "Sub Test ()" & vbLf & _
  27.            Space(4) & "Msgbox " & Chr(34) & "這是添加的代碼！" & Chr(34) & vbLf & _
  28.           "End Sub"
  29. Call AddNewCodeInComps(strNewCode, "模塊1")
復(fù)制代碼
6.9 代碼模塊中插入代碼操作
6.9.1 在某個(gè)部件指定行插入一行或多行代碼過(guò)程

  2. '過(guò)程功能：在代碼模塊的某個(gè)指定行，插入一行或多行的代碼
  3. '輸入?yún)?shù)：strNewCode（字符串）添加的代碼字符串
  4. '          CodeLines(長(zhǎng)整型)代碼行
  5. '          VBCompNameOrIndex(Variant)部件名或索引
  6. Sub InsertCodeInComps (ByVal strNewCode As String, _
  7.                   Optional CodeLines As Long = 1, _
  8.                   Optional VBCompNameOrIndex As Variant)
  9.    Dim VBProj           As VBProject
  10.    Dim VBCodeModule    As CodeModule
  11.    
  12.    Set VBProj = VBE.ActiveVBProject
  13.    
  14.    '如不指定部件代碼模塊，及為當(dāng)前窗格部件代碼模塊
  15.    If VBCompNameOrIndex = "" Then
  16.       Set VBCodeModule = VBE.ActiveCodePane.CodeModule
  17.    Else
  18.       Set VBCodeModule = VBProj.VBComponents(VBCompNameOrIndex).CodeModule
  19.    End If
  20.   
  21. '向模塊中指定行插入或添加新代碼
  22.    VBCodeModule.InsertLines CodeLines, strNewCode
  23. End Sub


  26. '*********************************************************
  27. '調(diào)用示例：向指定部件“模塊1”，第一第二行分別插入指定代碼
  28. Dim strNewCode1, strNewCode2  As String
  29. strNewCode1 =" Option Compare Database"
  30. strNewCode2 ="Option Explicit"

  32. Call InsertCodeInComps (strNewCode1, , "模塊1")
  33. Call InsertCodeInComps (strNewCode2, 2, "模塊1")
  34.   
復(fù)制代碼


6.10 代碼模塊中替換代碼操作
6.10.1 替換指定行原代碼

  2. '過(guò)程功能：用新代碼替換指定行原代碼
  3. '輸入?yún)?shù)：strNewCode（字符串）欲替換寫(xiě)入的新代碼字符串
  4. '          CodeLines(長(zhǎng)整型)欲替換的代碼行
  5. '          VBCompNameOrIndex(Variant)部件名或索引
  6. Sub ReplaceLineCodeInComps (ByVal strNewCode As String, _
  7.                   Optional CodeLines As Long = 1, _
  8.                   Optional VBCompNameOrIndex As Variant)
  9.    Dim VBProj           As VBProject
  10.    Dim VBCodeModule    As CodeModule
  11.    
  12.    Set VBProj = VBE.ActiveVBProject
  13.    
  14.    '如不指定部件或模塊，及為當(dāng)前窗格部件代碼模塊
  15.    If VBCompNameOrIndex = "" Then
  16.       Set VBCodeModule = VBE.ActiveCodePane.CodeModule
  17.    Else
  18.       Set VBCodeModule = VBProj.VBComponents (VBCompNameOrIndex).CodeModule
  19.    End If
  20.    '替換模塊中指定行為新代碼
  21.    VBCodeModule.ReplaceLine CodeLines, strNewCode
  22. End Sub


  25. '*********************************************************
  26. '調(diào)用示例：向指定部件“模塊1”，替換原第五行代碼為新代碼
  27. Dim strNewCode  As String
  28. strNewCode = Space(4) & "Msgbox " & Chr(34) & "這是替換的代碼！"
  29.                  
  30. Call ReplaceLineCodeInComps(strNewCode, 5, "模塊1")
復(fù)制代碼
作者: tanhong    時(shí)間: 2010-10-31 15:07
本帖最后由 tanhong 于 2010-10-31 15:56 編輯

6.11 代碼模塊中刪除代碼操作
6.11.1 刪除指定行代碼

  2. '過(guò)程功能：刪除指定行代碼
  3. '輸入?yún)?shù)：VBCompName (String字符串變量) 指定模塊名
  4. '          StartLine  代碼起始行
  5. '          LinesNum 代碼行數(shù),默認(rèn)為一行
  6. Sub DelLinesCodes (VBCompName As String, StartLine As Long, _
  7.                 Optional LinesNum As Long = 1)   
  8. Dim VBProj      As VBProject
  9.     Dim VBComps    As VBComponents
  10.    
  11.    Set VBProj = VBE.ActiveVBProject
  12.    Set VBComps = VBProj.VBComponents
  13.    
  14.    VBComps(VBCompName).CodeModule.DeleteLines StartLine, LinesNum
  15. End Sub

  17. '******************************************************************
  18. '調(diào)用示例一：刪除"模塊1"中，第一行代碼
  19. Call DelLinesCodes("模塊1", 1)

  21. '******************************************************************
  22. '調(diào)用示例二：刪除"模塊1"中，從第一行到第十行代碼
  23. CAll DelLinesCodes("模塊1", 1, 10)
復(fù)制代碼



6.11.2 刪除指定過(guò)程所有代碼

  2. '刪除指定過(guò)程代碼
  3. Public Sub DelProcCodes(VBCompName As String, VBProcName As String)
  4.    Dim VBProj       As VBProject
  5.    Dim VBComps     As VBComponents
  6.    Dim ProcKind      As vbext_ProcKind
  7.    
  8.    Set VBProj = VBE.ActiveVBProject
  9.    Set VBComps = VBProj.VBComponents
  10.    
  11.    With VBComps (VBCompName).CodeModule
  12.       .DeleteLines .ProcStartLine (VBProcName, ProcKind), _
  13.       .ProcCountLines (VBProcName, ProcKind)
  14.    End With
  15. End Sub

  17. '******************************************************************
  18. '調(diào)用示例：刪除“模塊1”中，“我的過(guò)程”所有代碼
  19. Call  DelProcCodes ("模塊1", "我的過(guò)程")
復(fù)制代碼

6.11.3 刪除部件或模塊中所有代碼

  2. '刪除指定模塊中所有代碼
  3. Public Sub DelVBCompCodes (ByVal VBCompName As String)
  4.    Dim VBProj    As VBProject
  5.    Dim VBComps  As VBComponents
  6.    
  7. '實(shí)例對(duì)象
  8.    Set VBProj = VBE.ActiveVBProject
  9.    Set VBComps = VBProj.VBComponents

  11.    '從代碼模塊中第一行到最后一行執(zhí)行刪除
  12.    VBComps(VBCompName).CodeModule.DeleteLines 1, _
  13.    VBComps(VBCompName).CodeModule.CountOfLines
  14. End Sub

  16. '******************************************************************
  17. '調(diào)用示例：刪除“模塊1”中所有代碼
  18. Call  DelVBCompCodes ("模塊1")
復(fù)制代碼


6.12 添加事件過(guò)程代碼操作
6.12.1 向指定部件對(duì)象添加事件

  2. '過(guò)程功能：創(chuàng)建一個(gè)事件過(guò)程
  3. '輸入?yún)?shù)：VBCompNameOrIndex（Variant）部件名或索引
  4. '          strEventProc(String)事件程序
  5. '          strEventObj(String)事件對(duì)象
  6. '          strInsertCode(String)事件中欲插入代碼,默認(rèn)為空
  7. Sub CreateEventProcCode (VBCompNameOrIndex As Variant, _
  8.                   strEventProc As String, _
  9.                   strEventObj As String, _
  10.                   Optional strInsertCode As String = "")
  11.    Dim VBProj     As VBProject
  12.    Dim VBComp    As VBComponent
  13.    Dim CodeMod    As CodeModule
  14.    Dim LineNum    As Long
  15.    
  16.    '實(shí)例化對(duì)象
  17.    Set VBProj = VBE.ActiveVBProject
  18.    Set VBComp = VBProj.VBComponents (VBCompNameOrIndex)
  19.    Set CodeMod = VBComp.CodeModule
  20.    
  21.    With CodeMod
  22.       LineNum = .CreateEventProc (strEventProc, strEventObj)
  23.       
  24. '是否為事件添了代碼，如未添加則退出
  25.       If strInsertCode = vbNullString Then Exit Sub
  26.         '從事件代碼之后插入新代碼
  27.          LineNum = LineNum + 1
  28.         .InsertLines LineNum, strInsertCode
  29.    End With
  30. End Sub


  33. '************************************************
  34. '調(diào)用示例一：在窗體1中創(chuàng)建窗體加載事件,并加入代碼
  35. Dim strProcCode  As String
  36. strProcCode = Space(4) & "Msgbox " & Chr(34) & "這是創(chuàng)建事件代碼演示！"
  37. Call CreateEventProcCode("Form_窗體1", "Load", "Form", strProcCode)

  39. '************************************************
  40. '調(diào)用示例二：在窗體1中創(chuàng)建窗體打開(kāi)事件,但不加入代碼
  41. Call CreateEventProcCode("Form_窗體1", "Open", "Form")
復(fù)制代碼
作者: tanhong    時(shí)間: 2010-10-31 15:08
本帖最后由 tanhong 于 2010-10-31 15:08 編輯

6.13 查找代碼獲取相關(guān)信息
6.13.1查找代碼文本獲取起止行列與是否存在信息
  1. '查找代碼文本信息定義數(shù)據(jù)類(lèi)型
  2. Public Type FindCodeInfo
  3. SLine As Long '起始行
  4. ELine As Long '結(jié)束行
  5. SCol As Long '起始列
  6. ECol As Long '結(jié)束列
  7. BooFound As Boolean '是否找到
  8. End Type

  10. '函數(shù)功能：搜索模塊中代碼文本自定義函數(shù)
  11. Function SearchCodeModule (ByVal VBCompNameOrIndex As Variant, _
  12. ByVal strFindCode As String) As FindCodeInfo
  13. Dim VBProj As VBProject
  14. Dim VBComp As VBComponent
  15. Dim CodeMod As CodeModule
  16. Dim Findcode As FindCodeInfo '自定義數(shù)據(jù)類(lèi)型
  17. Dim SL As Long '起始行
  18. Dim SC As Long '起始列
  19. Dim EL As Long '結(jié)束行
  20. Dim EC As Long '結(jié)束列
  21. Dim Found As Boolean '查找是否存在

  23. '實(shí)例對(duì)象
  24. Set VBProj = VBE.ActiveVBProject
  25. Set VBComp = VBProj.VBComponents (VBCompNameOrIndex)
  26. Set CodeMod = VBComp.CodeModule

  28. With CodeMod
  29. '初始起始行列值
  30. SL = 1: SC = 1
  31. '初始結(jié)束行列值
  32. EL = .CountOfLines: EC = 255
  33. '開(kāi)始查找
  34. Found = .Find (strFindCode, SL, SC, EL, EC, True, False, False)
  35. '如未找到繼續(xù)查找
  36. Do Until Found = False
  37. With Findcode
  38. .SLine = SL: .SCol = SC
  39. .ELine = EL: .ECol = EC
  40. .BooFound = Found
  41. End With
  42. EL = .CountOfLines: SC = EC + 1: EC = 255
  43. Found = .Find (strFindCode, SL, SC, EL, EC, True, False, False)
  44. Loop
  45. End With
  46. '賦值輸出
  47. SearchCodeModule = Findcode
  48. End Function


  51. '***************************************************
  52. '調(diào)用示例：查找模塊"bas_ProcInfo"中"程序申明行"文本，并獲取相關(guān)信息
  53. Dim FindInfo As FindCodeInfo '申明自定義數(shù)據(jù)類(lèi)型
  54. '查找并賦值給自定義數(shù)據(jù)類(lèi)型變量
  55. FindInfo = SearchCodeModule("bas_ProcInfo", "程序申明行")
  56. MsgBox "查找文件：" & FindInfo.BooFound & vbLf & _
  57. "起始行：" & FindInfo.SLine & vbLf & _
  58. "起始列：" & FindInfo.SCol & vbLf & _
  59. "結(jié)束行：" & FindInfo.ELine & vbLf & _
  60. "結(jié)束列：" & FindInfo.Ecol

復(fù)制代碼



以上為本人研究關(guān)于VBA擴(kuò)展類(lèi)庫(kù)在二次開(kāi)發(fā)中的一點(diǎn)心得，現(xiàn)將其匯集成文與大家分享。上述文字中的代碼并不能算最優(yōu)化，也未囊括VBA擴(kuò)展類(lèi)庫(kù)中對(duì)象所有屬性、方法，但對(duì)于解決二次開(kāi)發(fā)中可能遇到的大多數(shù)問(wèn)題還是很有幫助的。
因?yàn)�，成文較倉(cāng)促，再則部分代碼并未經(jīng)過(guò)細(xì)致測(cè)試，不免有錯(cuò)漏之處，還請(qǐng)各位看文者幫助斧正，并告知本人，在此謝過(guò)。
因篇幅考慮，部分代碼并未收入文中，大家可參看實(shí)例，文中“代碼實(shí)例”可在本人專(zhuān)欄或Access Home論壇下載。
作者: tmtony    時(shí)間: 2010-10-31 15:40
已經(jīng)很久沒(méi)寫(xiě)addin了, 一看到老兄的代碼,又勾起了興趣.
作者: tanhong    時(shí)間: 2010-10-31 15:54
很期待老大的新作。
作者: opelwang    時(shí)間: 2010-10-31 18:48
強(qiáng)貼，頂起。
跟著版主學(xué)習(xí)。
作者: li08hua    時(shí)間: 2010-10-31 19:15
很不錯(cuò)的教程，謝謝江主！
作者: zhuyiwen    時(shí)間: 2010-11-2 21:35
好貼子！
作者: sxb2007    時(shí)間: 2010-11-8 20:05
好貼子
作者: yyxtj    時(shí)間: 2010-12-14 23:19
高手，謝謝
作者: noami    時(shí)間: 2011-7-19 21:02
謝謝樓主提供學(xué)習(xí)資料
作者: yndlyb    時(shí)間: 2014-12-23 00:14
最近在學(xué)這個(gè)，來(lái)看看高手的。
作者: purplerose    時(shí)間: 2015-11-29 21:52
想了解一下，謝謝版主



歡迎光臨 Office中國(guó)論壇/Access中國(guó)論壇 (http://m.mzhfr.cn/) Powered by Discuz! X3.3