VBA代码编程方法详解

tanhong

一、前言

　　本文所说的VBA代码编程，即通过编程方法创建、删除或编辑VBA工程部件、模块或代码程序对象，还可以通过VBA代码创建新的代码，以此可以实现VBA的二次开发。

　　VBA代码编程，也就是所谓的VBA可扩展性。要实现VBA扩展功能，或者说实现对VBA代码的编程，我们必须事先完成以下相关设置。

1.1 引用VBA扩展类库（Microsoft Visual Basic For Applications Extensibility 5.3）

　　在ACCESS 2003中扩展库文件为：VBE6EXT.OLB，你可以在VBE（Visual Basic Editor即VB编辑器）窗口，点菜单 [工具] — [引用]，在 [引用对话框] 中钩，来手动引用该扩展类库，你也可以通过代码实现对其的引用。

1. 
   
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编辑器中）—[宏]—[安全性]，在 [安全对话框]中，单击 [可靠发行商] 页，点选 [信任对于“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_StdModule	1	标准模块
Vbext_ct_ClassModule	2	类模块
Vbext_ct_MSForm	3	Microsoft 窗体（非ACCESS类窗体）

l CodePane（代码窗格）

用 CodePane对象来操作 CodePane中可视文本的位置或者代码窗格中显示的文本选择。

lCodeModule（代码模块）

代码模块是VB部件VBA源代码，可用 CodeModule对象来修改（添加、删除、编辑）与部件相关联的代码CodePane 或CodeModule内程序类别 （prockind）常数：

常数	值	描述
vbext_pk_Proc	0	指定所有过程除了Property 过程。
vbext_pk_Let	1	指定一个赋值给属性的过程。
vbext_pk_Set	2	指定一个给对象设置引用的过程。
vbext_pk_Get	3	指定一个返回属性值的过程。

以上为VBA的可扩展模型部分对象（非全部对象），其它模型对象请参阅帮助。

tanhong

三、工程对象（Project）
　　表示一个工程。可用 VBProject对象设置工程的属性、访问 VBComponents集合以及访问 References集合。通常我们会用ActiveVBProject返回“工程”窗口中选定的工程，但在实际编程中，无论此工程是否被显式地选定，都只有一个工程是活动的。

3.1判断工程是否锁定
　　通过工程Protection属性，判断工程锁定状态。工程Protection属性（只读），指示工程是否处于保护状态。返回的值为一事先定义好的常量，表示工程的状态。
Protection属性常量：

常数	值	描述
Vbext_pp_none	0	常量代表指定的工程未被保护。
vbext_pp_locked	1	常量代表指定的工程是被锁住。

3.1.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调用自定义函数，判断当前工程是锁定示例

1. 
   
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向当前工程添加部件公用过程

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）
   
3. 
   
4. '例二：以指定名“我的类模块”添加标准模块
   
5. Call AddVBComponents(2, "我的类模块")

复制代码

4.1.4 调用自定义过程，添加（MSForm）窗体

1. '例一：以默认名添加MSForm窗体
   
2. Call AddVBComponents（3）
   
3. 
   
4. '例二：以指定名“我的窗体”添加MSForm窗体
   
5. Call AddVBComponents(3, "我的窗体")

复制代码

说明：这里窗体是指“Microsoft窗体”，而非ACCESS通常意义所说的窗体，ACCESS窗体实际为ACCESS类对象，你可以通过CreateForm方法创建一个ACCESS对象窗体。

tanhong

4.2 移除工程中部件
4.2.1 移除当前工程部件自定义过程

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　获得部件类型自定义函数

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 获取工程中所有部件名及类型自定义函数

1. 
   
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
    

复制代码

tanhong

4.4 判断部件是否存在
4.4.1判断部件是否存在自定义函数

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判断指定模块是否存在调用示例

1. 
   
2.    If VBComponentExists("模块1") = False Then
   
3.       MsgBox "不存在"
   
4.    Else
   
5.       MsgBox "存在"
   
6.    End If

复制代码

4.5 导入部件文件添加部件
4.5.1导入部件自定义过程

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导出部自定义过程

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")
   
3. 
   
4. '调用示例二：通过部件索引导出部件，实例中：索引[1]为[Form_窗体1]类对象
   
5. Call ExportVBCompsToFiles(1,"C:\ Form_窗体1.cls")

复制代码

说明：你可以通过“部件名”或“索引”来指定需导出部件。

4.6.3 根据部件类型获得输出部件文件后缀名

1. 
   
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类对象窗体。

tanhong

五、代码窗格对象（CodePane）
　　代码窗口中包含的代码窗格。代码窗口被用来输入和编辑代码。代码窗口可含有多个代码窗格。用 CodePane对象来操作 CodePane中代码或选取的代码或文本。

5.1 显示代码窗格
5.1.1显示当前代码窗格

1. '打开并显示当前代码窗格
   
2. Public Sub ShowProject ()
   
3. 　VBE.ActiveCodePane.Show
   
4. End Sub

复制代码

5.1.2显示指定部件代码模块窗格

1. 
   
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获取当前窗格中所选代码起止行列信息

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
   
9. 
   
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
    
20. 
    
21. 
    
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
    

复制代码

tanhong

六、代码模块对象（CodeModule）

　　在诸如窗体，类或文档等部件之后表示程序代码。可用 CodeModule对象来修改（添加、删除、编辑）与部件相关联的代码。
　　每个部件都与一个 CodeModule对象相关联。但是，一个 CodeModule对象可以与多个代码窗格CodePane相关联。

6.1 获得指定行代码
6.1.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
    
19. 
    
20. '***********************************************
    
21. '调用示例一：获得“模块1”，第五行代码
    
22. Debug.Print LineCodeString("模块1",5)
    
23. 
    
24. '***********************************************
    
25. '调用示例二：获得“模块1”，第一行至第六行代码
    
26. Debug.Print LineCodeString("模块1",1 ,6)

复制代码

6.2 列举模块中所有过程及类型
6.2.1获得过程种类自定义函数

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 获得指定部件中过程名及类型

1. 
   
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.       '申明后第一行开始循环至代码结束,将获取过程名及类型名输出
    
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
    
40. 
    
41. '***********************************************
    
42. '调用示例：获取"Form_窗体1"中所有过程名及类型
    
43. Debug.Print ListProcedures ("Form_窗体1")
    

复制代码

tanhong

6.3 判断过程是否存在
6.3.1 判断指定过程是否存在自定义函数

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.       '申明后第一行开始循环至代码结束,将获取过程名及类型名输出
    
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("过程名")
   
3. 
   
4. '示例二：指定过程名"ShowProcedureInfo"，并指定部件名
   
5. Debug.Print VBProcExists("过程名","部件名")
   
6. 
   
7. '示例三：指定过程名，并通过索引指定部件
   
8. Debug.Print VBProcExists("过程名",3)

复制代码

6.4 获得指定行所在过程名
6.4.1 获得指定行过程名自定义函数

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)

复制代码

tanhong

6.5 获取过程代码行数信息
6.5.1指定过程总代码行数

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
    
19. 
    
20. '******************************************************************
    
21. '调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程总行数
    
22. Debug.Print TotalCodeLinesInProc("bas_ProcInfo", "ShowProcedureInfo")

复制代码

6.5.2 指定过程代码起始行数

1. 
   
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
    
16. 
    
17. '******************************************************************
    
18. '调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程起始行号
    
19. Debug.Print StartLineInProc ("bas_ProcInfo", "ShowProcedureInfo")
    

复制代码

6.5.3 指定过程实际代码起始行数

1. 
   
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
    
16. 
    
17. '******************************************************************
    
18. '调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程实际起始行号
    
19. Debug.Print CodeBodyLineInProc ("bas_ProcInfo", "ShowProcedureInfo")
    

复制代码

6.5.4 指定过程实际代码行数

1. 
   
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        '循环变量
    
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
    
35. 
    
36. '******************************************************************
    
37. '调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程实际行数
    
38. Debug.Print CodeLinesInProc ("bas_ProcInfo", "ShowProcedureInfo")
    

复制代码

tanhong

6.6 获取部件或模块中代码行信息
6.6.1 获取部件或模块中申明部分行数

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
    
16. 
    
17. '******************************************************************
    
18. '调用示例：获得部件"bas_ProcInfo"模块中申明部分总代码行数
    
19. Debug.Print TotalDeclLinesInVBComp ("bas_ProcInfo")
    

复制代码

6.6.2 获得指定模块中总代码行数

1. 
   
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
    
16. 
    
17. '******************************************************************
    
18. '调用示例：获得部件"bas_ProcInfo"模块中总代码行数
    
19. Debug.Print TotalCodeLinesInVBComp ("bas_ProcInfo")
    
20. 
    

复制代码

6.6.3 获得指定部件或模块中实际代码行数

1. 
   
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.       '循环每行代码
    
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
    
31. 
    
32. '******************************************************************
    
33. '调用示例：获得部件"bas_ProcInfo"模块中实际代码行数
    
34. Debug.Print CodeLinesInVBComp ("bas_ProcInfo")

复制代码

6.7 获取工程代码行数信息
6.7.1工程总代码行数

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
    
21. 
    
22.    TotalCodeLinesInProject = LineCount
    
23. End Function

复制代码

6.7.2工程实际代码行数

1. 
   
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

复制代码

tanhong

6.8 代码模块中添加代码操作
6.8.1 向指定部件添加一行代码

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
    
21. 
    
22. 
    
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 在某个部件指定行插入一行或多行代码过程

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
    
24. 
    
25. 
    
26. '*********************************************************
    
27. '调用示例：向指定部件“模块1”，第一第二行分别插入指定代码
    
28. Dim strNewCode1, strNewCode2  As String
    
29. strNewCode1 =" Option Compare Database"
    
30. strNewCode2 ="Option Explicit"
    
31. 
    
32. Call InsertCodeInComps (strNewCode1, , "模块1")
    
33. Call InsertCodeInComps (strNewCode2, 2, "模块1")
    
34.   

复制代码

6.10 代码模块中替换代码操作
6.10.1 替换指定行原代码

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
    
23. 
    
24. 
    
25. '*********************************************************
    
26. '调用示例：向指定部件“模块1”，替换原第五行代码为新代码
    
27. Dim strNewCode  As String
    
28. strNewCode = Space(4) & "Msgbox " & Chr(34) & "这是替换的代码！"
    
29.                  
    
30. Call ReplaceLineCodeInComps(strNewCode, 5, "模块1")

复制代码