VBA代码编程方法详解

一、前言 本文所说的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编辑器）窗口，点菜单 工具 引用，在 引用对话框 中钩，来手动引用该扩展类库，你也可以通过代码实现对其的引用。Dim ref As Reference 申明引用类对象On Error Resume Next 避免因重复引用造成的错误提示通过扩展库标识号，主版本号，次版本号完成引用Set ref = References.AddFromGuid (0002E157-0000-0000-C000-000000000046, 5, 3)1.2 需要启用编程方式访问VBA项目（仅在EXCEL中需设定）在Excel 2003和更早版中，需设定允许对VBA项目的访问，否则将报错。ACCESS则不需对该项进行设定。点选菜单 工具（在Excel中，而不是在VBA编辑器中）宏安全性，在 安全对话框中，单击 可靠发行商 页，点选 信任对于“Visual Basic项目”的访问 项（见下图）注册表键值：HKLMSoftwareMicrosoftOffice11.0ExcelSecurityAccessVBOM, 1, REG_DWORD键值为：1，则钩选；0，则取消钩选二、VBA的可扩展模型对象简介 l Library VBIDE（扩展库）路径：C:Program FilesCommon FilesMicrosoft SharedVBAVBA6VBE6EXT.OLB描述：Microsoft Visual Basic for Applications Extensibility 5.3l 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的可扩展模型部分对象（非全部对象），其它模型对象请参阅帮助。三、工程对象（Project）表示一个工程。可用 VBProject对象设置工程的属性、访问 VBComponents集合以及访问 References集合。通常我们会用ActiveVBProject返回“工程”窗口中选定的工程，但在实际编程中，无论此工程是否被显式地选定，都只有一个工程是活动的。3.1判断工程是否锁定通过工程Protection属性，判断工程锁定状态。工程Protection属性（只读），指示工程是否处于保护状态。返回的值为一事先定义好的常量，表示工程的状态。Protection属性常量：常数值描述Vbext_pp_none0常量代表指定的工程未被保护。vbext_pp_locked1常量代表指定的工程是被锁住。3.1.1 判断工程是否锁定自定义函数函数功能：判断工程是否锁定Public Function VBProjectlocked (Optional VBProj As VBProject = Nothing) As Boolean Dim Proj As VBProject 如未指定工程，则为当前工程 If VBProj Is Nothing Then Set Proj = VBE.ActiveVBProject Else Set Proj = VBProj End If 判断工程是否锁定 If Proj.Protection = vbext_pp_locked Then VBProjectlocked = True Else VBProjectlocked = False End IfEnd Function3.1.2调用自定义函数，判断当前工程是锁定示例 函数输出为真（True），否则当前工程锁定If VBProjectlocked = True Then MsgBox 工程已锁定 Else MsgBox 工程未锁定 End If3.2 获得工程名获得当前工程名VBE.ActiveVBProject.Name四、部件对象（VBComponent）代表一个包含在工程中的部件，例如类模块或标准模块。使用 VBComponent对象访问与部件关联的代码模块CodeModule或改变部件的属性设置。4.1 添加工程部件4.1.1向当前工程添加部件公用过程*公用过程：添加模块或指定名模块 ComponentType部件类型（可选参数），默认为标准模块 VBCompName部件名（可选参数），默认不指定部件名*Public Sub AddVBComponents (Optional ComponentType As vbext_ComponentType=1, _ Optional VBCompName As String = ) Dim VBProj As VBProject 申明工程（项目）对象 Dim VBComps As VBComponents 申明部件集合 设定为当前工程 Set VBProj = VBE.ActiveVBProject设定为当前工程部件集合 Set VBComps = VBProj.VBComponents 判断是否指定部件名，未指定则按默认名建立指定类型部件 If VBCompName = Then VBComps.Add (ComponentType) Else VBComps.Add (ComponentType).Name = VBCompName End IfEnd Sub4.1.2调用自定义过程，添加标准模块例一：以默认名添加标准模块Call AddVBComponents例二：以指定名“我的模块”添加标准模块Call AddVBComponents(, 我的模块)4.1.3调用自定义过程，添加类模块例一：以默认名添加类模块Call AddVBComponents（2）例二：以指定名“我的类模块”添加标准模块Call AddVBComponents(2, 我的类模块)4.1.4 调用自定义过程，添加（MSForm）窗体例一：以默认名添加MSForm窗体Call AddVBComponents（3）例二：以指定名“我的窗体”添加MSForm窗体Call AddVBComponents(3, 我的窗体)说明：这里窗体是指“Microsoft窗体”，而非ACCESS通常意义所说的窗体，ACCESS窗体实际为ACCESS类对象，你可以通过CreateForm方法创建一个ACCESS对象窗体。4.2 移除工程中部件4.2.1 移除当前工程部件自定义过程*公用过程：移除指定部件或删除某类部件ComponentType部件类别（可选参数），默认为标准模块VBCompName部件名（可选参数），默认不指定部件名*Public Sub RemoveVBComponents (Optional VBCompType As vbext_ComponentType, _ Optional VBCompName As String = ) Dim VBProj As VBProject 申明工程对象 Dim VBComp As VBComponent 申明部件对象 Dim VBComps As VBComponents 申明部件集合 设定为当前工程 Set VBProj = VBE.ActiveVBProject设定为当前工程部件 Set VBComps = VBProj.VBComponents 判断是否指定部件名，如未指定则删除所有指定类型部件 If VBCompName And VBCompType = 0 Then VBComps.Remove VBComps (VBCompName) Else For Each VBComp In VBComps If VBComp.Type = VBCompType Then VBComps.Remove VBComps (VBComp.Name) End If Next End IfEnd Sub4.2.2调用自定义过程，移除指定类型所有部件示例移除指定所有类模块Call RemoveVBComponents（vbext_ct_ClassModule）4.2.3调用自定义过程，移除指定名部件示例（无需指定部件类型）移除指定名部件，实例：指定“我的窗体”Call RemoveVBComponents(, 我的窗体)4.3 列举部件名及类型信息4.3.1获得部件类型自定义函数-函数功能：根据所获取部件类型常量值，获得部件类别名-Function ComponentTypeToString (ComponentType As vbext_ComponentType) As String Select Case ComponentType Case vbext_ct_ClassModule ComponentTypeToString = 类模块 Case 100 ComponentTypeToString = 其它 Case vbext_ct_MSForm ComponentTypeToString = 微软窗体 Case vbext_ct_StdModule ComponentTypeToString = 标准模块 Case Else ComponentTypeToString = 未知类: & CStr(ComponentType) End SelectEnd Function4.4 判断部件是否存在4.4.1判断部件是否存在自定义函数-函数功能：判断指定模块是否存在,存在输出为True-Public Function VBComponentExists (ByVal VBCompName As String) As Boolean Dim VBProj As VBProject On Error Resume Next Set VBProj = VBE.ActiveVBProject 存在输出为True，否则为False VBComponentExists = CBool(Len(VBProj.VBComponents(VBCompName).Name)End Function4.4.2判断指定模块是否存在调用示例 If VBComponentExists(模块1) = False Then MsgBox 不存在 Else MsgBox 存在 End If4.5 导入部件文件添加部件4.5.1导入部件自定义过程导入部件文件添加部件输入参数：FileName(字符串变量) 指示欲添加部件的路径及文件名Public Sub ImportFilesToVBComps (FileName As String) Dim VBProj As VBProject Dim VBComps As VBComponents On Error Resume Next Set VBProj = VBE.ActiveVBProject Set VBComps = VBProj.VBComponents 导入指定部件文件，添加部件 VBComps.Import (FileName)End Sub4.5.2导入部件文件示例调用示例：从指定C盘导入部件文件模块1添加到当前工程Call ImportFilesToVBComps(C:模块1)说明：导入文件部件如与部件重名，不会覆盖原部件，而是添加序号重新命名。4.6 导出部件为部件文件4.6.1导出部自定义过程过程功能：导出部件为部件文件输入参数：FileName(字符串变量) 用来指定部件输出为文件的文件名及导出路径 CompsFile(Variant) 可以是部件名或是部件索引，用以指定欲导出部件Public Sub ExportVBCompsToFiles (CompsFile As Variant, FileName As String) Dim VBProj As VBProject Dim VBComps As VBComponents On Error Resume Next Set VBProj = VBE.ActiveVBProject Set VBComps = VBProj.VBComponents (CompsFile) 导出部件为部件文件 VBComps.Import (FileName)End Sub4.6.2 导出部件示例调用示例一：指定部件（模块1）Call ExportVBCompsToFiles(模块1,C:模块1.bas)调用示例二：通过部件索引导出部件，实例中：索引1为Form_窗体1类对象Call ExportVBCompsToFiles(1,C: Form_窗体1.cls)说明：你可以通过“部件名”或“索引”来指定需导出部件。4.6.3 根据部件类型获得输出部件文件后缀名根据部件类型，确定输出部件文件后缀名Public Function GetFileExtension (VBComp As VBIDE.VBComponent) As String Select Case VBComp.Type Case vbext_ct_ClassModule GetFileExtension = .cls Case vbext_ct_Document GetFileExtension = .cls Case vbext_ct_MSForm GetFileExtension = .frm Case vbext_ct_StdModule GetFileExtension = .bas Case Else GetFileExtension = .bas End SelectEnd Function说明：导出文件名要根据不同部件类型，指定后缀名，见下表：部件对象后缀名描述ACCESS类对象cls通常所说的“窗体”或“报表”对象等。类模块cls含有类定义的模块。标准模块bas只包含过程、类型以及数据的声明和定义的模块。窗体frm指微软窗体，而非ACCESS类对象窗体。五、代码窗格对象（CodePane）代码窗口中包含的代码窗格。代码窗口被用来输入和编辑代码。代码窗口可含有多个代码窗格。用 CodePane对象来操作 CodePane中代码或选取的代码或文本。5.1 显示代码窗格5.1.1显示当前代码窗格打开并显示当前代码窗格Public Sub ShowProject ()VBE.ActiveCodePane.ShowEnd Sub5.1.2显示指定部件代码模块窗格函数功能：打开指定部件代码模块窗格Public Sub ShowComponent (ByVal CompsNameOrIndex As Variant) Dim VBProj As VBProject 工程项目对象 Dim VBComp As VBComponent 组件对象 Dim CodeMod As CodeModule 代码模块 Dim VBCodePane As CodePane 窗格对象 实例化对象 Set VBProj = VBE.ActiveVBProject Set VBComp = VBProj.VBComponents (CompsNameOrIndex) Set CodeMod = VBComp.CodeModule Set VBCodePane = CodeMod.CodePane VBCodePane.Show 显示代码窗格End Sub5.2 获取窗格所选代码行列信息5.2.1获取当前窗格中所选代码起止行列信息所选代码的起止行列信息定义数据类型Public Type SelLineColInfo SLine As Long 起始行 SCol As Long 起始列 ELine As Long 结束行 ECol As Long 结束列End Type-函数功能：获得所选代码开始行列及结束行列信息Public Function VBGetSelection () As SelLineColInfo Dim SelInfo As SelLineColInfo 数据类型 VBE.ActiveCodePane.GetSelection SelInfo.SLine, SelInfo.SCol, _ SelInfo.ELine, SelInfo.ECol 获取的行列信息输出 VBGetSelection = SelInfoEnd Function*调用示例：在窗格中任选一处代码行列，再运行以下代码Dim SelInfo As SelLineColInfo 申明自定数据类型起止行列信息赋值给变量 SelInfo = VBGetSelection输出显示 MsgBox 起始行： & SelInfo.SLine & vbLf & _ 起始列： & SelInfo.SCol & vbLf & _ 结束行： & SelInfo.ELine & vbLf & _ 结束列： & SelInfo.Ecol六、代码模块对象（CodeModule）在诸如窗体，类或文档等部件之后表示程序代码。可用 CodeModule对象来修改（添加、删除、编辑）与部件相关联的代码。每个部件都与一个 CodeModule对象相关联。但是，一个 CodeModule对象可以与多个代码窗格CodePane相关联。6.1 获得指定行代码6.1.1 获得指定模块中指定一行或多行代码函数功能：指定模块指定行代码输入参数：CompsNameOrIndex 部件名或索引 CodeLine(长整)代码所在行 CountLines(长整)可选参数，选取代码行数,默认为1行Public Function LineCodeString (ByVal CompsNameOrIndex, _ ByVal CodeLine As Long, _ Optional CountLines As Long = 1) As String Dim VBProj As VBProject Dim VBComp As VBComponent Dim CodeMod As CodeModule Set VBProj = VBE.ActiveVBProject Set VBComp = VBProj.VBComponents (CompsNameOrIndex) Set CodeMod = VBComp.CodeModule LineCodeString = CodeMod.Lines (CodeLine, CountLines)End Function*调用示例一：获得“模块1”，第五行代码Debug.Print LineCodeString(模块1,5)*调用示例二：获得“模块1”，第一行至第六行代码Debug.Print LineCodeString(模块1,1 ,6)6.2 列举模块中所有过程及类型6.2.1获得过程种类自定义函数 函数功能：获得过程种类名 输入参数：ProcKind（过程类型常数）Public Function ProcKindString(ByVal ProcKind As vbext_ProcKind) As String Select Case ProcKind Case vbext_pk_Get ProcKindString = roperty Get Case vbext_pk_Let ProcKindString = roperty Let Case vbext_pk_Set ProcKindString = roperty Set Case vbext_pk_Proc ProcKindString = Sub Or Function Case Else ProcKindString = Unknown Type: & CStr(ProcKind) End SelectEnd Function6.2.2 获得指定部件中过程名及类型-函数功能：列出指定模块中所有过程输入参数：CompsNameOrIndex 部件名或索引调 用：自定义ProcKindString函数-Public Function ListProcedures (CompsNameOrIndex As Variant) As String Dim VBProj As VBProject 工程 Dim VBComp As VBComponent 部件 Dim CodeMod As CodeModule 代码模块 Dim ProcKind As vbext_ProcKind 过程类型 Dim LineNum As Long 代码行 Dim sProcKind As String 过程类型名 Dim ProcName As String 过程名 实例化当前活动的工程 Set VBProj = VBE.ActiveVBProject 实例化工程对象集合 Set VBComp = VBProj.VBComponents(CompsNameOrIndex) 实例化代码模块 Set CodeMod = VBComp.CodeModule With CodeMod 获得代码所在起始行,等于申明行加一 LineNum = .CountOfDeclarationLines + 1 获得指定行所在过程名 ProcName = .ProcOfLine(LineNum, ProcKind) 申明后第一行开始循环至代码结束,将获取过程名及类型名输出 Do Until LineNum = .CountOfLines sProcKind = sProcKind & ProcName & Space(3) & _ProcKindString(ProcKind) & vbLf 代码行数累加, 将根据所在行获得过程名 LineNum = LineNum + .ProcCountLines(ProcName, ProcKind) ProcName = .ProcOfLine(LineNum, ProcKind) Loop End With ListProcedures = sProcKindEnd Function*调用示例：获取Form_窗体1中所有过程名及类型Debug.Print ListProcedures (Form_窗体1)6.3 判断过程是否存在6.3.1 判断指定过程是否存在自定义函数函数功能：判断指定过程是否存在,存在输出为真Public Function VBProcExists(ByVal VBProcName As String, _ Optional VBCompNameOrIndex As Variant) As Boolean Dim VBProj As VBProject Dim VBCodeModule As CodeModule Dim ProcKind As vbext_ProcKind 过程类型 Dim LineNum As Long 代码行 Dim ProcName As String 获得过程名 Set VBProj = VBE.ActiveVBProject 如不指定部件及为当前窗格代码模块 If VBCompNameOrIndex = Then Set VBCodeModule = VBE.ActiveCodePane.CodeModule Else Set VBCodeModule = VBProj.VBComponents(VBCompNameOrIndex).CodeModule End If With VBCodeModule 获得代码所在起始行,等于申明行加一 LineNum = .CountOfDeclarationLines + 1 获得指定行所在过程名 ProcName = .ProcOfLine (LineNum, ProcKind) 申明后第一行开始循环至代码结束,将获取过程名及类型名输出 Do Until LineNum = .CountOfLines 代码行数累加,将根据所在行获得过程名 LineNum = LineNum + .ProcCountLines (ProcName, ProcKind) ProcName = .ProcOfLine (LineNum, ProcKind) 进行二进制比对,比对结果等一，则存在 If StrComp (VBProcName, ProcName) = 1 Then VBProcExists = True Exit Do End If Loop End WithEnd Function6.3.2 调用自定义函数示例示例一：指定过程名，但不指定部件Debug.Print VBProcExists(过程名)示例二：指定过程名ShowProcedureInfo，并指定部件名Debug.Print VBProcExists(过程名,部件名)示例三：指定过程名，并通过索引指定部件Debug.Print VBProcExists(过程名,3)6.4 获得指定行所在过程名6.4.1 获得指定行过程名自定义函数-函数功能：获得指定行过程名-Public Function GetLineProcName (ByVal LineNum As Long) As String Dim CodeMod As CodeModule 申明代码模块 Dim VBpane As VBIDE.CodePane 代码模块所在窗格 Dim NumLines As Long 代码行数 Dim ProcName As String 过程名 Dim ProcKind As vbext_ProcKind 过程类型 实例化为当前代码窗口 Set VBpane = VBE.ActiveCodePane 实例化为当前窗格代码模块 Set CodeMod = VBpane.CodeModule With CodeMod 获得代码起始行行数 NumLines = .CountOfDeclarationLines + 1 判断是否为申明代码行 If LineNum NumLines Then ProcName = .ProcOfLine (LineNum, ProcKind) Else GetLineProcName = -1 如为申明代码行，则输出为负1 Exit Function End If End With 过程名输出 GetLineProcName = ProcNameEnd Function6.4.2调用指定行过程名函数示例获得指当前代码窗口行号第26行代码所在过程名Call GetLineProcName(26)6.5 获取过程代码行数信息6.5.1指定过程总代码行数函数功能：获得指定过程总的代码行数(含过程中的所有空行及注释)Public Function TotalCodeLinesInProc(CompsNameOrIndex, _ strProcName As String, _ Optional ProcKind As vbext_ProcKind = 0) As Long Dim VBProj As VBProject 工程对象 Dim VBComp As VBComponent 部件对象 Dim CodeMod As CodeModule 代码模块 设定为当前工程 Set VBProj = VBE.ActiveVBProject 设定为指定部件 Set VBComp = VBProj.VBComponents(CompsNameOrIndex) 设定为指定部件代码模块 Set CodeMod = VBComp.CodeModule 过程计数输出 TotalCodeLinesInProc = CodeMod.ProcCountLines(strProcName, ProcKind)End Function*调用示例：获得部件bas_ProcInfo模块中，ShowProcedureInfo过程总行数Debug.Print TotalCodeLinesInProc(bas_ProcInfo, ShowProcedureInfo)6.5.2 指定过程代码起始行数函数功能：获得指定过程代码起始行(从过程之上的空行和注释计算)Public Function StartLineInProc (CompsNameOrIndex, _ strProcName As String, _ Optional ProcKind As vbext_ProcKind = 0) As Long Dim VBProj As VBProject Dim VBComp As VBComponent Dim CodeMod As CodeModule Set VBProj = VBE.ActiveVBProject Set VBComp = VBProj.VBComponents (CompsNameOrIndex) Set CodeMod = VBComp.CodeModule StartLineInProc = CodeMod.ProcStartLine(strProcName, ProcKind)End Function*调用示例：获得部件bas_ProcInfo模块中，ShowProcedureInfo过程起始行号Debug.Print StartLineInProc (bas_ProcInfo, ShowProcedureInfo)6.5.3 指定过程实际代码起始行数函数功能：获得过程第一行代码行(从过程的实际代码行计算,不含过程之上空行和注释)Public Function CodeBodyLineInProc (CompsNameOrIndex, _ strProcName As String, _ Optional ProcKind As vbext_ProcKind = 0) As Long Dim VBProj As VBProject Dim VBComp As VBComponent Dim CodeMod As CodeModule Set VBProj = VBE.ActiveVBProject Set VBComp = VBProj.VBComponents(CompsNameOrIndex) Set CodeMod = VBComp.CodeModule CodeBodyLineInProc = CodeMod.ProcBodyLine(strProcName, ProcKind)End Function*调用示例：获得部件bas_ProcInfo模块中，ShowProcedureInfo过程实际起始行号Debug.Print CodeBodyLineInProc (bas_ProcInfo, ShowProcedureInfo)6.5.4 指定过程实际代码行数函数功能：获得指定过程实际代码行数(不包含空行和注释行)Public Function CodeLinesInProc(ByVal CompsNameOrIndex, _ ByVa