設為首頁收藏本站Access中國

Office中國論壇/Access中國論壇

 找回密碼
 注冊

QQ登錄

只需一步，快速開始

123下一頁
返回列表 發(fā)新帖
查看: 15456|回復: 21
打印 上一主題 下一主題

VBA代碼編程方法詳解

[復制鏈接]
跳轉到指定樓層
1#
發(fā)表于 2010-10-31 14:57:20 | 只看該作者 回帖獎勵 |倒序瀏覽 |閱讀模式
本帖最后由 tanhong 于 2010-10-31 19:40 編輯

一、前言
　　本文所說的VBA代碼編程，即通過編程方法創(chuàng)建、刪除或編輯VBA工程部件、模塊或代碼程序對象，還可以通過VBA代碼創(chuàng)建新的代碼，以此可以實現VBA的二次開發(fā)。
　　VBA代碼編程，也就是所謂的VBA可擴展性。要實現VBA擴展功能，或者說實現對VBA代碼的編程，我們必須事先完成以下相關設置。

1.1 引用VBA擴展類庫（Microsoft Visual Basic For Applications Extensibility 5.3）
　　在ACCESS 2003中擴展庫文件為：VBE6EXT.OLB，你可以在VBE（Visual Basic Editor即VB編輯器）窗口，點菜單 [工具] — [引用]，在 [引用對話框] 中鉤，來手動引用該擴展類庫，你也可以通過代碼實現對其的引用。

  2. Dim ref As Reference
  3. '申明引用類對象
  4. On Error Resume Next '避免因重復引用造成的錯誤提示
  5. '通過擴展庫標識號，主版本號，次版本號完成引用
  6. Set ref = References.AddFromGuid ("{0002E157-0000-0000-C000-000000000046}", 5, 3)
復制代碼


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

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

l VBProject（工程）
VB工程（或稱項目）中包含了所有的代碼模塊和部件。VB項目可包含若干個VB部件對象。

l VBComponent（部件）
代表包含在工程中的部件對象，如：類模塊或標準模塊。部件（VBComponent） 對象的 Type屬性：
常數值描述
Vbext_ct_StdModule1標準模塊
Vbext_ct_ClassModule2類模塊
Vbext_ct_MSForm3Microsoft 窗體（非ACCESS類窗體）

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

lCodeModule（代碼模塊）
代碼模塊是VB部件VBA源代碼，可用 CodeModule對象來修改（添加、刪除、編輯）與部件相關聯的代碼CodePane 或CodeModule內程序類別 （prockind）常數：
常數值描述
vbext_pk_Proc0指定所有過程除了Property 過程。
vbext_pk_Let1指定一個賦值給屬性的過程。
vbext_pk_Set2指定一個給對象設置引用的過程。
vbext_pk_Get3指定一個返回屬性值的過程。
以上為VBA的可擴展模型部分對象（非全部對象），其它模型對象請參閱幫助。

本帖子中包含更多資源

您需要 登錄 才可以下載或查看，沒有帳號？注冊

x
分享到:  QQ好友和群QQ好友和群 QQ空間QQ空間 騰訊微博騰訊微博 騰訊朋友騰訊朋友
收藏收藏4 分享分享 分享淘帖 訂閱訂閱
2#
 樓主| 發(fā)表于 2010-10-31 14:59:54 | 只看該作者
本帖最后由 tanhong 于 2010-10-31 15:02 編輯

三、工程對象（Project）
　　表示一個工程�？捎� VBProject對象設置工程的屬性、訪問 VBComponents集合以及訪問 References集合。通常我們會用ActiveVBProject返回“工程”窗口中選定的工程，但在實際編程中，無論此工程是否被顯式地選定，都只有一個工程是活動的。

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


3.1.1 判斷工程是否鎖定自定義函數

  2. '函數功能：判斷工程是否鎖定
  3. Public Function VBProjectlocked (Optional VBProj As VBProject = Nothing) As Boolean
  4.    Dim Proj   As VBProject
  5.    
  6. '如未指定工程，則為當前工程
  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
復制代碼


3.1.2調用自定義函數，判斷當前工程是鎖定示例

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

3.2 獲得工程名
  1. '獲得當前工程名
  2. VBE.ActiveVBProject.Name
復制代碼


四、部件對象（VBComponent）
　　代表一個包含在工程中的部件，例如類模塊或標準模塊。使用 VBComponent對象訪問與部件關聯的代碼模塊CodeModule或改變部件的屬性設置。

4.1 添加工程部件
4.1.1向當前工程添加部件公用過程

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


4.1.2調用自定義過程，添加標準模塊
  1. '例一：以默認名添加標準模塊
  2. Call AddVBComponents
  3. '例二：以指定名“我的模塊”添加標準模塊
  4. Call AddVBComponents(, "我的模塊")
復制代碼


4.1.3調用自定義過程，添加類模塊
  1. '例一：以默認名添加類模塊
  2. Call AddVBComponents（2）

  4. '例二：以指定名“我的類模塊”添加標準模塊
  5. Call AddVBComponents(2, "我的類模塊")
復制代碼


4.1.4 調用自定義過程，添加（MSForm）窗體
  1. '例一：以默認名添加MSForm窗體
  2. Call AddVBComponents（3）

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


說明：這里窗體是指“Microsoft窗體”，而非ACCESS通常意義所說的窗體，ACCESS窗體實際為ACCESS類對象，你可以通過CreateForm方法創(chuàng)建一個ACCESS對象窗體。
3#
 樓主| 發(fā)表于 2010-10-31 15:03:30 | 只看該作者
4.2 移除工程中部件
4.2.1 移除當前工程部件自定義過程

  2. '***********************************************
  3. '公用過程：移除指定部件或刪除某類部件
  4. 'ComponentType部件類別（可選參數），默認為標準模塊
  5. 'VBCompName部件名（可選參數），默認不指定部件名
  6. '************************************************
  7. Public Sub RemoveVBComponents (Optional VBCompType As vbext_ComponentType, _
  8.                               Optional VBCompName As String = "")
  9.    Dim VBProj     As VBProject      '申明工程對象
  10.    Dim VBComp   As VBComponent   '申明部件對象
  11.    Dim VBComps  As VBComponents  '申明部件集合
  12.    '設定為當前工程
  13.    Set VBProj = VBE.ActiveVBProject
  14. '設定為當前工程部件
  15.    Set VBComps = VBProj.VBComponents
  16.    '判斷是否指定部件名，如未指定則刪除所有指定類型部件
  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
復制代碼

4.2.2　調用自定義過程，移除指定類型所有部件示例
  1. '移除指定所有類模塊
  2. Call RemoveVBComponents（vbext_ct_ClassModule）
復制代碼


4.2.3  調用自定義過程，移除指定名部件示例（無需指定部件類型）
  1. '移除指定名部件，實例：指定“我的窗體”
  2. Call RemoveVBComponents(, "我的窗體")
復制代碼


4.3 列舉部件名及類型信息
4.3.1　獲得部件類型自定義函數

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


4.3.2 獲取工程中所有部件名及類型自定義函數

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

  2. '-----------------------------------------------------------------------
  3. '函數功能：判斷指定模塊是否存在,存在輸出為True
  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.    '存在輸出為True，否則為False
  10.    VBComponentExists = CBool(Len(VBProj.VBComponents(VBCompName).Name))
  11. End Function
復制代碼


4.4.2判斷指定模塊是否存在調用示例

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


4.5 導入部件文件添加部件
4.5.1導入部件自定義過程

  2. '導入部件文件添加部件
  3. '輸入參數：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.    '導入指定部件文件，添加部件
  13.    VBComps.Import (FileName)
  14. End Sub
復制代碼

4.5.2導入部件文件示例
  1. '調用示例：從指定C盤導入部件文件"模塊1"添加到當前工程
  2. Call ImportFilesToVBComps("C:\模塊1")
復制代碼

說明：導入文件部件如與部件重名，不會覆蓋原部件，而是添加序號重新命名。

4.6 導出部件為部件文件
4.6.1導出部自定義過程

  2. '過程功能：導出部件為部件文件
  3. '輸入參數：FileName(字符串變量) 用來指定部件輸出為文件的文件名及導出路徑
  4. '           CompsFile(Variant) 可以是部件名或是部件索引，用以指定欲導出部件
  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.    '導出部件為部件文件
  14.    VBComps.Import (FileName)
  15. End Sub
復制代碼

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

  4. '調用示例二：通過部件索引導出部件，實例中：索引[1]為[Form_窗體1]類對象
  5. Call ExportVBCompsToFiles(1,"C:\ Form_窗體1.cls")
復制代碼

說明：你可以通過“部件名”或“索引”來指定需導出部件。

4.6.3 根據部件類型獲得輸出部件文件后綴名

  2. '根據部件類型，確定輸出部件文件后綴名
  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
復制代碼


說明：導出文件名要根據不同部件類型，指定后綴名，見下表：
部件對象
后綴名
描述
ACCESS類對象
cls
通常所說的“窗體”或“報表”對象等。
類模塊
cls
含有類定義的模塊。
標準模塊
bas
只包含過程、類型以及數據的聲明和定義的模塊。
窗體
frm
指微軟窗體，而非ACCESS類對象窗體。
5#
 樓主| 發(fā)表于 2010-10-31 15:04:45 | 只看該作者
五、代碼窗格對象（CodePane）
　　代碼窗口中包含的代碼窗格。代碼窗口被用來輸入和編輯代碼。代碼窗口可含有多個代碼窗格。用 CodePane對象來操作 CodePane中代碼或選取的代碼或文本。

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


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

  2. '函數功能：打開指定部件代碼模塊窗格
  3. Public Sub ShowComponent (ByVal CompsNameOrIndex As Variant)
  4.    Dim VBProj       As VBProject        '工程項目對象
  5.    Dim VBComp      As VBComponent    '組件對象
  6.    Dim CodeMod     As CodeModule      '代碼模塊
  7.    Dim VBCodePane   As CodePane        '窗格對象
  8.    
  9.    '實例化對象
  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
復制代碼



5.2 獲取窗格所選代碼行列信息
5.2.1獲取當前窗格中所選代碼起止行列信息

  2. '所選代碼的起止行列信息定義數據類型
  3. Public Type SelLineColInfo
  4.    SLine  As Long        '起始行
  5.    SCol   As Long        '起始列
  6.    ELine  As Long        '結束行
  7.    ECol   As Long        '結束列
  8. End Type

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


  22. '***************************************************
  23. '調用示例：在窗格中任選一處代碼行列，再運行以下代碼
  24. Dim SelInfo As SelLineColInfo '申明自定數據類型
  25. '起止行列信息賦值給變量   
  26. SelInfo = VBGetSelection
  27. '輸出顯示   
  28. MsgBox "起始行：" & SelInfo.SLine & vbLf & _
  29.        "起始列：" & SelInfo.SCol & vbLf & _
  30.        "結束行：" & SelInfo.ELine & vbLf & _
  31.        "結束列：" & SelInfo.ECol
復制代碼
6#
 樓主| 發(fā)表于 2010-10-31 15:05:14 | 只看該作者
六、代碼模塊對象（CodeModule）

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

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

  2. '函數功能：指定模塊指定行代碼
  3. '輸入參數：CompsNameOrIndex 部件名或索引
  4. '          CodeLine(長整)代碼所在行
  5. '          CountLines(長整)可選參數，選取代碼行數,默認為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. '調用示例一：獲得“模塊1”，第五行代碼
  22. Debug.Print LineCodeString("模塊1",5)

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


6.2 列舉模塊中所有過程及類型
6.2.1獲得過程種類自定義函數

  2. ' 函數功能：獲得過程種類名
  3. ' 輸入參數：ProcKind（過程類型常數）
  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
復制代碼


6.2.2 獲得指定部件中過程名及類型

  2. '---------------------------------------------------------------------
  3. '函數功能：列出指定模塊中所有過程
  4. '輸入參數：CompsNameOrIndex 部件名或索引
  5. '調    用：自定義ProcKindString函數
  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       '過程類型
  12.    Dim LineNum    As Long                '代碼行
  13.    Dim sProcKind   As String                '過程類型名
  14.    Dim ProcName   As String                '過程名
  15.    
  16.    '實例化當前活動的工程
  17.    Set VBProj = VBE.ActiveVBProject
  18.    '實例化工程對象集合
  19.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  20.    '實例化代碼模塊
  21.    Set CodeMod = VBComp.CodeModule
  22.    
  23.    With CodeMod
  24.       '獲得代碼所在起始行,等于申明行加一
  25.       LineNum = .CountOfDeclarationLines + 1
  26.       '獲得指定行所在過程名
  27.       ProcName = .ProcOfLine(LineNum, ProcKind)
  28.       '申明后第一行開始循環(huán)至代碼結束,將獲取過程名及類型名輸出
  29.       Do Until LineNum >= .CountOfLines
  30.          sProcKind = sProcKind & ProcName & Space(3) & _
  31. ProcKindString(ProcKind) & vbLf
  32.          '代碼行數累加, 將根據所在行獲得過程名
  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. '調用示例：獲取"Form_窗體1"中所有過程名及類型
  43. Debug.Print ListProcedures ("Form_窗體1")
復制代碼
7#
 樓主| 發(fā)表于 2010-10-31 15:05:42 | 只看該作者
6.3 判斷過程是否存在
6.3.1 判斷指定過程是否存在自定義函數

  2. '函數功能：判斷指定過程是否存在,存在輸出為真
  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        '過程類型
  8.    Dim LineNum         As Long                 '代碼行
  9.    Dim ProcName        As String                 '獲得過程名
  10.    
  11.    Set VBProj = VBE.ActiveVBProject
  12.    '如不指定部件及為當前窗格代碼模塊
  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.       '獲得指定行所在過程名
  23.       ProcName = .ProcOfLine (LineNum, ProcKind)
  24.       '申明后第一行開始循環(huán)至代碼結束,將獲取過程名及類型名輸出
  25.       Do Until LineNum >= .CountOfLines
  26.          '代碼行數累加,將根據所在行獲得過程名
  27.          LineNum = LineNum + .ProcCountLines (ProcName, ProcKind)
  28.          ProcName = .ProcOfLine (LineNum, ProcKind)
  29.          '進行二進制比對,比對結果等一，則存在
  30.          If StrComp (VBProcName, ProcName) = 1 Then
  31.             VBProcExists = True
  32.             Exit Do
  33.          End If
  34.       Loop
  35.    End With
  36. End Function
復制代碼

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

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

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



6.4 獲得指定行所在過程名
6.4.1 獲得指定行過程名自定義函數

  2. '---------------------------------------------------------------------
  3. '函數功能：獲得指定行過程名
  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                 '代碼行數
  9.    Dim ProcName   As String                 '過程名
  10.    Dim ProcKind    As vbext_ProcKind        '過程類型
  11.    
  12.    '實例化為當前代碼窗口
  13.    Set VBpane = VBE.ActiveCodePane
  14.    '實例化為當前窗格代碼模塊
  15.    Set CodeMod = VBpane.CodeModule
  16.    
  17.    With CodeMod
  18.       '獲得代碼起始行行數
  19.       NumLines = .CountOfDeclarationLines + 1
  20.       '判斷是否為申明代碼行
  21.       If LineNum > NumLines Then
  22.          ProcName = .ProcOfLine (LineNum, ProcKind)
  23.       Else
  24.          GetLineProcName = -1   '如為申明代碼行，則輸出為負1
  25.          Exit Function
  26.       End If
  27.    End With
  28.    '過程名輸出
  29.    GetLineProcName = ProcName
  30. End Function
復制代碼

6.4.2調用指定行過程名函數示例
  1. '獲得指當前代碼窗口行號第26行代碼所在過程名
  2. Call GetLineProcName(26)
復制代碼
8#
 樓主| 發(fā)表于 2010-10-31 15:06:07 | 只看該作者
6.5 獲取過程代碼行數信息
6.5.1指定過程總代碼行數

  2. '函數功能：獲得指定過程總的代碼行數(含過程中的所有空行及注釋)
  3. Public Function TotalCodeLinesInProc(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.    '設定為當前工程
  11.    Set VBProj = VBE.ActiveVBProject
  12.    '設定為指定部件
  13.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  14.    '設定為指定部件代碼模塊
  15.    Set CodeMod = VBComp.CodeModule
  16.    '過程計數輸出
  17.    TotalCodeLinesInProc = CodeMod.ProcCountLines(strProcName, ProcKind)
  18. End Function

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


6.5.2 指定過程代碼起始行數

  2. '函數功能：獲得指定過程代碼起始行(從過程之上的空行和注釋計算)
  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. '調用示例：獲得部件"bas_ProcInfo"模塊中，"ShowProcedureInfo"過程起始行號
  19. Debug.Print StartLineInProc ("bas_ProcInfo", "ShowProcedureInfo")
復制代碼


6.5.3 指定過程實際代碼起始行數

  2. '函數功能：獲得過程第一行代碼行(從過程的實際代碼行計算,不含過程之上空行和注釋)
  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. '調用示例：獲得部件"bas_ProcInfo"模塊中，"ShowProcedureInfo"過程實際起始行號
  19. Debug.Print CodeBodyLineInProc ("bas_ProcInfo", "ShowProcedureInfo")
復制代碼

6.5.4 指定過程實際代碼行數

  2. '函數功能：獲得指定過程實際代碼行數(不包含空行和注釋行)
  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         '代碼總行數
  12.    Dim I          As Integer        '循環(huán)變量
  13.    Dim strCode    As String         '代碼
  14.    Dim LineCount  As Long         '行計數變量
  15.    實例化對象
  16.    Set VBProj = VBE.ActiveVBProject
  17.    Set VBComp = VBProj.VBComponents(CompsNameOrIndex)
  18.    Set CodeMod = VBComp.CodeModule
  19.    '獲取開始行號和總行數
  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.       '跳過空行和注釋行
  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.    '實際行數輸出
  33.    CodeLinesInProc = LineCount
  34. End Function

  36. '******************************************************************
  37. '調用示例：獲得部件"bas_ProcInfo"模塊中，"ShowProcedureInfo"過程實際行數
  38. Debug.Print CodeLinesInProc ("bas_ProcInfo", "ShowProcedureInfo")
復制代碼
9#
 樓主| 發(fā)表于 2010-10-31 15:06:33 | 只看該作者
6.6 獲取部件或模塊中代碼行信息
6.6.1 獲取部件或模塊中申明部分行數

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

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


6.6.2 獲得指定模塊中總代碼行數

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

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

復制代碼



6.6.3 獲得指定部件或模塊中實際代碼行數

  2. '函數功能：獲得指定部件或模塊代碼數。包括申明及代碼，但不含注釋代碼行及空白行
  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.    '實例化對象
  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.            '跳過空行注釋行
  23.          Else
  24.             LineCount = LineCount + 1
  25.          End If
  26.       Next I
  27.    End With
  28.    '獲取實際代碼計數輸出
  29.    CodeLinesInVBComp = LineCount
  30. End Function

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


6.7 獲取工程代碼行數信息
6.7.1工程總代碼行數

  2. '函數功能：工程總代碼行數(含空及注釋)
  3. '調    用：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.    '判斷工程是否鎖定，則退出函數,
  12.    If VBProj.Protection = vbext_pp_locked Then
  13.       TotalCodeLinesInProject = -1
  14.       Exit Function
  15.    End If
  16.    
  17.    '遍歷當前工程中所有部件
  18.    For Each VBComp In VBProj.VBComponents
  19.       LineCount = LineCount + TotalCodeLinesInVBComp(VBComp.Name)
  20.    Next VBComp

  22.    TotalCodeLinesInProject = LineCount
  23. End Function
復制代碼

6.7.2工程實際代碼行數

  2. '函數功能：工程實際代碼行數(不含空及注釋)
  3. '調    用：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.    '遍歷當前工程中所有部件對象
  12.    For Each VBComp In VBProj.VBComponents
  13.       LineCount = LineCount + CodeLinesInVBComp(VBComp.Name)
  14.    Next VBComp
  15.    
  16.    CodeLinesInProject = LineCount
  17. End Function
復制代碼
10#
 樓主| 發(fā)表于 2010-10-31 15:07:02 | 只看該作者
6.8 代碼模塊中添加代碼操作
6.8.1 向指定部件添加一行代碼

  2. '過程功能：向指定部件或模塊添加代碼
  3. '輸入參數：strNewCode（字符串）添加的代碼字符串
  4. '          VBCompNameOrIndex(Variant)可選參數，部件名或索引
  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.    '如不指定部件或模塊，及為當前窗格部件代碼模塊
  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. '調用示例：向指定部件“模塊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")
復制代碼
6.9 代碼模塊中插入代碼操作
6.9.1 在某個部件指定行插入一行或多行代碼過程

  2. '過程功能：在代碼模塊的某個指定行，插入一行或多行的代碼
  3. '輸入參數：strNewCode（字符串）添加的代碼字符串
  4. '          CodeLines(長整型)代碼行
  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.    '如不指定部件代碼模塊，及為當前窗格部件代碼模塊
  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. '調用示例：向指定部件“模塊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.   
復制代碼


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

  2. '過程功能：用新代碼替換指定行原代碼
  3. '輸入參數：strNewCode（字符串）欲替換寫入的新代碼字符串
  4. '          CodeLines(長整型)欲替換的代碼行
  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.    '如不指定部件或模塊，及為當前窗格部件代碼模塊
  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. '調用示例：向指定部件“模塊1”，替換原第五行代碼為新代碼
  27. Dim strNewCode  As String
  28. strNewCode = Space(4) & "Msgbox " & Chr(34) & "這是替換的代碼！"
  29.                  
  30. Call ReplaceLineCodeInComps(strNewCode, 5, "模塊1")
復制代碼
您需要登錄后才可以回帖 登錄 | 注冊

本版積分規(guī)則

QQ|站長郵箱|小黑屋|手機版|Office中國/Access中國 ( 粵ICP備10043721號-1 )  

GMT+8, 2025-7-13 08:07 , Processed in 0.140530 second(s), 35 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回復 返回頂部 返回列表