VBA编程方法

2024年1月29日发(作者：)

一、前言本文所说的VBA代码编程，即通过编程方法创建、删除或编辑VBA工程部件、模块或代码程序对象，还可以通过VBA代码创建新的代码，以此可以实现VBA的二次开发。VBA代码编程，也就是所谓的VBA可扩展性。要实现VBA扩展功能，或者说实现对VBA代码的编程，我们必须事先完成以下相关设置。1.1引用VBA扩展类库（MicrosoftVisualBasicForApplicationsExtensibility5.3）在ACCESS2003中扩展库文件为：，你可以在VBE（VisualBasicEditor即VB编辑器）窗口，点菜单[工具]—[引用]，在[引用对话框]中钩，来手动引用该扩展类库，你也可以通过代码实现对其的引用。DimrefAsReference'申明引用类对象OnErrorResumeNext'避免因重复引用造成的错误提示'通过扩展库标识号，主版本号，次版本号完成引用Setref=mGuid("{0002E157-0000-0000-C0046}",5,3)1.2需要启用编程方式访问VBA项目（仅在EXCEL中需设定）在Excel2003和更早版中，需设定允许对VBA项目的访问，否则将报错。ACCESS则不需对该项进行设定。点选菜单[工具]（在Excel中，而不是在VBA编辑器中）—[宏]—[安全性]，在[安全对话框]中，单击[可靠发行商]页，点选[信任对于“VisualBasic项目”的访问]项（见下图）

注册表键值：HKLMSoftwareMicrosoftOffice11.0ExcelSecurityAccessVBOM",1,"REG_DWORD"键值为：1，则钩选；0，则取消钩选二、VBA的可扩展模型对象简介LibraryVBIDE（扩展库）路径：C:描述：MicrosoftVisualBasicforApplicationsExtensibility5.3VBE（VB编辑器）指VB编辑器，为根对象，其包含所有其它可在VisualBasicforApplications中表示的对象和集合。VBProject（工程）VB工程（或称项目）中包含了所有的代码模块和部件。VB项目可包含若干个VB部件对象。VBComponent（部件）代表包含在工程中的部件对象，如：类模块或标准模块。部件（VBComponent）对象的Type属性：常数Vbext_ct_StdModuleVbext_ct_ClassModuleVbext_ct_MSForm值123描述标准模块类模块Microsoft窗体（非ACCESS类窗体）CodePane（代码窗格）用CodePane对象来操作CodePane中可视文本的位置或者代码窗格中显示的文本选择。CodeModule（代码模块）

代码模块是VB部件VBA源代码，可用CodeModule对象来修改（添加、删除、编辑）与部件相关联的代码CodePane或CodeModule内程序类别（prockind）常数：常数vbext_pk_Procvbext_pk_Letvbext_pk_Setvbext_pk_Get值0123描述指定所有过程除了Property过程。指定一个赋值给属性的过程。指定一个给对象设置引用的过程。指定一个返回属性值的过程。以上为VBA的可扩展模型部分对象（非全部对象），其它模型对象请参阅帮助。三、工程对象（Project）表示一个工程。可用VBProject对象设置工程的属性、访问VBComponents集合以及访问References集合。通常我们会用ActiveVBProject返回“工程”窗口中选定的工程，但在实际编程中，无论此工程是否被显式地选定，都只有一个工程是活动的。3.1判断工程是否锁定通过工程Protection属性，判断工程锁定状态。工程Protection属性（只读），指示工程是否处于保护状态。返回的值为一事先定义好的常量，表示工程的状态。Protection属性常量：常数Vbext_pp_nonevbext_pp_locked值01描述常量代表指定的工程未被保护。常量代表指定的工程是被锁住。3.1.1判断工程是否锁定自定义函数'函数功能：判断工程是否锁定PublicFunctionVBProjectlocked(OptionalVBProjAsVBProject=Nothing)AsBooleanDimProjAsVBProject'如未指定工程，则为当前工程IfVBProjIsNothingThenSetProj=VBProjectElseSetProj=VBProjEndIf'判断工程是否锁定tion=vbext_pp_lockedThenVBProjectlocked=TrueElse

VBProjectlocked=FalseEndIfEndFunction3.1.2调用自定义函数，判断当前工程是锁定示例'函数输出为真（True），否则当前工程锁定IfVBProjectlocked=TrueThenMsgBox"工程已锁定"ElseMsgBox"工程未锁定"EndIf3.2获得工程名'获得当前工程名四、部件对象（VBComponent）代表一个包含在工程中的部件，例如类模块或标准模块。使用VBComponent对象访问与部件关联的代码模块CodeModule或改变部件的属性设置。4.1添加工程部件4.1.1向当前工程添加部件公用过程'***************************************************'公用过程：添加模块或指定名模块'ComponentType部件类型（可选参数），默认为标准模块'VBCompName部件名（可选参数），默认不指定部件名'***************************************************PublicSubAddVBComponents(OptionalComponentTypeAsvbext_ComponentType=1,_OptionalVBCompNameAsString="")DimVBProjAsVBProject'申明工程（项目）对象DimVBCompsAsVBComponents'申明部件集合'设定为当前工程SetVBProj=VBProject设定为当前工程部件集合SetVBComps=onents'判断是否指定部件名，未指定则按默认名建立指定类型部件IfVBCompName=""(ComponentType)(ComponentType).Name=VBCompNameEndIfEndSub4.1.2调用自定义过程，添加标准模块'例一：以默认名添加标准模块

CallAddVBComponents'例二：以指定名“我的模块”添加标准模块CallAddVBComponents(,"我的模块")4.1.3调用自定义过程，添加类模块'例一：以默认名添加类模块CallAddVBComponents（2）'例二：以指定名“我的类模块”添加标准模块CallAddVBComponents(2,"我的类模块")4.1.4调用自定义过程，添加（MSForm）窗体'例一：以默认名添加MSForm窗体CallAddVBComponents（3）'例二：以指定名“我的窗体”添加MSForm窗体CallAddVBComponents(3,"我的窗体")说明：这里窗体是指“Microsoft窗体”，而非ACCESS通常意义所说的窗体，ACCESS窗体实际为ACCESS类对象，你可以通过CreateForm方法创建一个ACCESS对象窗体。4.2移除工程中部件4.2.1移除当前工程部件自定义过程'***********************************************'公用过程：移除指定部件或删除某类部件'ComponentType部件类别（可选参数），默认为标准模块'VBCompName部件名（可选参数），默认不指定部件名'************************************************PublicSubRemoveVBComponents(OptionalVBCompTypeAsvbext_ComponentType,_OptionalVBCompNameAsString="")DimVBProjAsVBProject'申明工程对象DimVBCompAsVBComponent'申明部件对象DimVBCompsAsVBComponents'申明部件集合'设定为当前工程SetVBProj=VBProject'设定为当前工程部件SetVBComps=onents'判断是否指定部件名，如未指定则删除所有指定类型部件IfVBCompName<>""AndVBCompType=VBComps(VBCompName)=VBComps()EndIfNextEndIfEndSub

4.2.2调用自定义过程，移除指定类型所有部件示例'移除指定所有类模块CallRemoveVBComponents（vbext_ct_ClassModule）4.2.3调用自定义过程，移除指定名部件示例（无需指定部件类型）'移除指定名部件，实例：指定“我的窗体”CallRemoveVBComponents(,"我的窗体")4.3列举部件名及类型信息4.3.1获得部件类型自定义函数'------------------------------------------------------------'函数功能：根据所获取部件类型常量值，获得部件类别名'------------------------------------------------------------FunctionComponentTypeToString(ComponentTypeAsvbext_ComponentType)AsStringSelectCaseComponentTypeCasevbext_ct_ClassModuleComponentTypeToString="类模块"Case100ComponentTypeToString="其它"Casevbext_ct_MSFormComponentTypeToString="微软窗体"Casevbext_ct_StdModuleComponentTypeToString="标准模块"CaseElseComponentTypeToString="未知类:"&CStr(ComponentType)EndSelectEndFunction4.4判断部件是否存在4.4.1判断部件是否存在自定义函数'-----------------------------------------------------------------------'函数功能：判断指定模块是否存在,存在输出为True'-----------------------------------------------------------------------PublicFunctionVBComponentExists(ByValVBCompNameAsString)AsBooleanDimVBProjAsVBProjectOnErrorResumeNextSetVBProj=VBProject'存在输出为True，否则为FalseVBComponentExists=CBool(Len(onents(VBCompName).Name))EndFunction4.4.2判断指定模块是否存在调用示例IfVBComponentExists("模块1")=FalseThenMsgBox"不存在"

ElseMsgBox"存在"EndIf4.5导入部件文件添加部件4.5.1导入部件自定义过程'导入部件文件添加部件'输入参数：FileName(字符串变量)指示欲添加部件的路径及文件名PublicSubImportFilesToVBComps(FileNameAsString)DimVBProjAsVBProjectDimVBCompsAsVBComponentsOnErrorResumeNextSetVBProj=VBProjectSetVBComps=onents'导入指定部件文件，添加部件(FileName)EndSub4.5.2导入部件文件示例'调用示例：从指定C盘导入部件文件"模块1"添加到当前工程CallImportFilesToVBComps("C:模块1")说明：导入文件部件如与部件重名，不会覆盖原部件，而是添加序号重新命名。4.6导出部件为部件文件4.6.1导出部自定义过程'过程功能：导出部件为部件文件'输入参数：FileName(字符串变量)用来指定部件输出为文件的文件名及导出路径'CompsFile(Variant)可以是部件名或是部件索引，用以指定欲导出部件PublicSubExportVBCompsToFiles(CompsFileAsVariant,FileNameAsString)DimVBProjAsVBProjectDimVBCompsAsVBComponentsOnErrorResumeNextSetVBProj=VBProjectSetVBComps=onents(CompsFile)'导出部件为部件文件(FileName)EndSub4.6.2导出部件示例'调用示例一：指定部件（模块1）CallExportVBCompsToFiles("模块1","C:模块")'调用示例二：通过部件索引导出部件，实例中：索引[1]为[Form_窗体1]类对象CallExportVBCompsToFiles(1,"C:Form_窗体")

说明：你可以通过“部件名”或“索引”来指定需导出部件。4.6.3根据部件类型获得输出部件文件后缀名'根据部件类型，确定输出部件文件后缀名PublicFunctionGetFileExtension(onent)sevbext_ct_ClassModuleGetFileExtension=".cls"Casevbext_ct_DocumentGetFileExtension=".cls"Casevbext_ct_MSFormGetFileExtension=".frm"Casevbext_ct_StdModuleGetFileExtension=".bas"CaseElseGetFileExtension=".bas"EndSelectEndFunction说明：导出文件名要根据不同部件类型，指定后缀名，见下表：部件对象ACCESS类对象类模块标准模块窗体后缀名clsclsbasfrm描述通常所说的“窗体”或“报表”对象等。含有类定义的模块。只包含过程、类型以及数据的声明和定义的模块。指微软窗体，而非ACCESS类对象窗体。五、代码窗格对象（CodePane）代码窗口中包含的代码窗格。代码窗口被用来输入和编辑代码。代码窗口可含有多个代码窗格。用CodePane对象来操作CodePane中代码或选取的代码或文本。5.1显示代码窗格5.1.1显示当前代码窗格'打开并显示当前代码窗格PublicSubShowProject()dSub5.1.2显示指定部件代码模块窗格'函数功能：打开指定部件代码模块窗格PublicSubShowComponent(ByValCompsNameOrIndexAsVariant)DimVBProjAsVBProject'工程项目对象DimVBCompAsVBComponent'组件对象DimCodeModAsCodeModule'代码模块DimVBCodePaneAsCodePane'窗格对象

'实例化对象SetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=duleSetVBCodePane=dSub'显示代码窗格5.2获取窗格所选代码行列信息5.2.1获取当前窗格中所选代码起止行列信息'所选代码的起止行列信息定义数据类型PublicTypeSelLineColInfoSLineAsLong'起始行SColAsLong'起始列ELineAsLong'结束行EColAsLong'结束列EndType'-----------------------------------------------------------------------'函数功能：获得所选代码开始行列及结束行列信息PublicFunctionVBGetSelection()AsSelLineColInfoDimSelInfoAsSelLineColInfo'数据类型,,_,'获取的行列信息输出VBGetSelection=SelInfoEndFunction'***************************************************'调用示例：在窗格中任选一处代码行列，再运行以下代码DimSelInfoAsSelLineColInfo'申明自定数据类型'起止行列信息赋值给变量SelInfo=VBGetSelection'输出显示MsgBox"起始行："&&vbLf&_"起始列："&&vbLf&_"结束行："&&vbLf&_"结束列："&六、代码模块对象（CodeModule）

在诸如窗体，类或文档等部件之后表示程序代码。可用CodeModule对象来修改（添加、删除、编辑）与部件相关联的代码。每个部件都与一个CodeModule对象相关联。但是，一个CodeModule对象可以与多个代码窗格CodePane相关联。6.1获得指定行代码6.1.1获得指定模块中指定一行或多行代码'函数功能：指定模块指定行代码'输入参数：CompsNameOrIndex部件名或索引'CodeLine(长整)代码所在行'CountLines(长整)可选参数，选取代码行数,默认为1行PublicFunctionLineCodeString(ByValCompsNameOrIndex,_ByValCodeLineAsLong,_OptionalCountLinesAsLong=1)AsStringDimVBProjAsVBProjectDimVBCompAsVBComponentDimCodeModAsCodeModuleSetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=duleLineCodeString=(CodeLine,CountLines)EndFunction'***********************************************'调用示例一：获得“模块1”，第五行代码ineCodeString("模块1",5)'***********************************************'调用示例二：获得“模块1”，第一行至第六行代码ineCodeString("模块1",1,6)6.2列举模块中所有过程及类型6.2.1获得过程种类自定义函数'函数功能：获得过程种类名'输入参数：ProcKind（过程类型常数）PublicFunctionProcKindString(ByValProcKindAsvbext_ProcKind)AsStringSelectCaseProcKindCasevbext_pk_GetProcKindString="ropertyGet"Casevbext_pk_LetProcKindString="ropertyLet"Casevbext_pk_Set

ProcKindString="ropertySet"Casevbext_pk_ProcProcKindString="SubOrFunction"CaseElseProcKindString="UnknownType:"&CStr(ProcKind)EndSelectEndFunction6.2.2获得指定部件中过程名及类型'---------------------------------------------------------------------'函数功能：列出指定模块中所有过程'输入参数：CompsNameOrIndex部件名或索引'调用：自定义ProcKindString函数'---------------------------------------------------------------------PublicFunctionListProcedures(CompsNameOrIndexAsVariant)AsStringDimVBProjAsVBProject'工程DimVBCompAsVBComponent'部件DimCodeModAsCodeModule'代码模块DimProcKindAsvbext_ProcKind'过程类型DimLineNumAsLong'代码行DimsProcKindAsString'过程类型名DimProcNameAsString'过程名'实例化当前活动的工程SetVBProj=VBProject'实例化工程对象集合SetVBComp=onents(CompsNameOrIndex)'实例化代码模块SetCodeMod=duleWithCodeMod'获得代码所在起始行,等于申明行加一LineNum=.CountOfDeclarationLines+1'获得指定行所在过程名ProcName=.ProcOfLine(LineNum,ProcKind)'申明后第一行开始循环至代码结束,将获取过程名及类型名输出DoUntilLineNum>=.CountOfLinessProcKind=sProcKind&ProcName&Space(3)&_ProcKindString(ProcKind)&vbLf'代码行数累加,将根据所在行获得过程名LineNum=LineNum+.ProcCountLines(ProcName,ProcKind)ProcName=.ProcOfLine(LineNum,ProcKind)LoopEndWith

ListProcedures=sProcKindEndFunction'***********************************************'调用示例：获取"Form_窗体1"中所有过程名及类型istProcedures("Form_窗体1")6.3判断过程是否存在6.3.1判断指定过程是否存在自定义函数'函数功能：判断指定过程是否存在,存在输出为真PublicFunctionVBProcExists(ByValVBProcNameAsString,_OptionalVBCompNameOrIndexAsVariant)AsBooleanDimVBProjAsVBProjectDimVBCodeModuleAsCodeModuleDimProcKindAsvbext_ProcKind'过程类型DimLineNumAsLong'代码行DimProcNameAsString'获得过程名SetVBProj=VBProject'如不指定部件及为当前窗格代码模块IfVBCompNameOrIndex=""ThenSetVBCodeModule=duleElseSetVBCodeModule=onents(VBCompNameOrIndex).CodeModuleEndIfWithVBCodeModule'获得代码所在起始行,等于申明行加一LineNum=.CountOfDeclarationLines+1'获得指定行所在过程名ProcName=.ProcOfLine(LineNum,ProcKind)'申明后第一行开始循环至代码结束,将获取过程名及类型名输出DoUntilLineNum>=.CountOfLines'代码行数累加,将根据所在行获得过程名LineNum=LineNum+.ProcCountLines(ProcName,ProcKind)ProcName=.ProcOfLine(LineNum,ProcKind)'进行二进制比对,比对结果等一，则存在IfStrComp(VBProcName,ProcName)=1ThenVBProcExists=TrueExitDoEndIfLoopEndWithEndFunction6.3.2调用自定义函数示例

'示例一：指定过程名，但不指定部件BProcExists("过程名")'示例二：指定过程名"ShowProcedureInfo"，并指定部件名BProcExists("过程名","部件名")'示例三：指定过程名，并通过索引指定部件BProcExists("过程名",3)6.4获得指定行所在过程名6.4.1获得指定行过程名自定义函数'---------------------------------------------------------------------'函数功能：获得指定行过程名'---------------------------------------------------------------------PublicFunctionGetLineProcName(ByValLineNumAsLong)AsStringDimCodeModAsCodeModule'申明代码模块ne'代码模块所在窗格DimNumLinesAsLong'代码行数DimProcNameAsString'过程名DimProcKindAsvbext_ProcKind'过程类型'实例化为当前代码窗口SetVBpane=CodePane'实例化为当前窗格代码模块SetCodeMod=duleWithCodeMod'获得代码起始行行数NumLines=.CountOfDeclarationLines+1'判断是否为申明代码行IfLineNum>NumLinesThenProcName=.ProcOfLine(LineNum,ProcKind)ElseGetLineProcName=-1'如为申明代码行，则输出为负1ExitFunctionEndIfEndWith'过程名输出GetLineProcName=ProcNameEndFunction6.4.2调用指定行过程名函数示例'获得指当前代码窗口行号第26行代码所在过程名CallGetLineProcName(26)6.5获取过程代码行数信息6.5.1指定过程总代码行数

'函数功能：获得指定过程总的代码行数(含过程中的所有空行及注释)PublicFunctionTotalCodeLinesInProc(CompsNameOrIndex,_strProcNameAsString,_OptionalProcKindAsvbext_ProcKind=0)AsLongDimVBProjAsVBProject'工程对象DimVBCompAsVBComponent'部件对象DimCodeModAsCodeModule'代码模块'设定为当前工程SetVBProj=VBProject'设定为指定部件SetVBComp=onents(CompsNameOrIndex)'设定为指定部件代码模块SetCodeMod=dule'过程计数输出TotalCodeLinesInProc=untLines(strProcName,ProcKind)EndFunction'******************************************************************'调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程总行数otalCodeLinesInProc("bas_ProcInfo","ShowProcedureInfo")6.5.2指定过程代码起始行数'函数功能：获得指定过程代码起始行(从过程之上的空行和注释计算)PublicFunctionStartLineInProc(CompsNameOrIndex,_strProcNameAsString,_OptionalProcKindAsvbext_ProcKind=0)AsLongDimVBProjAsVBProjectDimVBCompAsVBComponentDimCodeModAsCodeModuleSetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=duleStartLineInProc=artLine(strProcName,ProcKind)EndFunction'******************************************************************'调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程起始行号tartLineInProc("bas_ProcInfo","ShowProcedureInfo")6.5.3指定过程实际代码起始行数'函数功能：获得过程第一行代码行(从过程的实际代码行计算,不含过程之上空行和注释)PublicFunctionCodeBodyLineInProc(CompsNameOrIndex,_strProcNameAsString,_

DimVBProjDimVBCompDimCodeModOptionalProcKindAsvbext_ProcKind=0)AsLongAsVBProjectAsVBComponentAsCodeModuleSetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=duleCodeBodyLineInProc=dyLine(strProcName,ProcKind)EndFunction'******************************************************************'调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程实际起始行号odeBodyLineInProc("bas_ProcInfo","ShowProcedureInfo")6.5.4指定过程实际代码行数'函数功能：获得指定过程实际代码行数(不包含空行和注释行)PublicFunctionCodeLinesInProc(ByValCompsNameOrIndex,_ByValstrProcNameAsString,_OptionalProcKindAsvbext_ProcKind=0)AsLongDimVBProjAsVBProjectDimVBCompAsVBComponentDimCodeModAsCodeModuleDimProcStartAsLong'代码起始行DimProcTotalAsLong'代码总行数DimIAsInteger'循环变量DimstrCodeAsString'代码DimLineCountAsLong'行计数变量实例化对象SetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=dule'获取开始行号和总行数ProcStart=artLine(strProcName,ProcKind)ProcTotal=untLines(strProcName,ProcKind)+ProcStartForI=ProcStartToProcTotal'将代码赋值给字符串变量strCode=(I,1)'跳过空行和注释行IfTrim(strCode)=vbNullStringOrLeft(Trim(strCode),1)=Chr(39)ThenElseLineCount=LineCount+1

EndIfNextI'实际行数输出CodeLinesInProc=LineCountEndFunction'******************************************************************'调用示例：获得部件"bas_ProcInfo"模块中，"ShowProcedureInfo"过程实际行数odeLinesInProc("bas_ProcInfo","ShowProcedureInfo")6.6获取部件或模块中代码行信息6.6.1获取部件或模块中申明部分行数'函数功能：获得指定部件或模块中申明部分总代码行数(含注释行及空行)PublicFunctionTotalDeclLinesInVBComp(CompsNameOrIndex)AsLongDimVBProjAsVBProject'申明工程项目对象DimVBCompAsVBComponent'申明项目组件对象DimCodeModAsCodeModule'申明组件代码'实例化对象SetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=dule'获得申明代码行数并输出TotalDeclLinesInVBComp=fDeclarationLinesEndFunction'******************************************************************'调用示例：获得部件"bas_ProcInfo"模块中申明部分总代码行数otalDeclLinesInVBComp("bas_ProcInfo")6.6.2获得指定模块中总代码行数'函数功能：获得指定模块中总代码行数(含申明代码行、注释行及空行)PublicFunctionTotalCodeLinesInVBComp(CompsNameOrIndex)AsLongDimVBProjAsVBProjectDimVBCompAsVBComponentDimCodeModAsCodeModule'实例化对象SetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=dule'获得部件或模块中代码总行数并输出TotalCodeLinesInVBComp=fLinesEndFunction

'******************************************************************'调用示例：获得部件"bas_ProcInfo"模块中总代码行数otalCodeLinesInVBComp("bas_ProcInfo")6.6.3获得指定部件或模块中实际代码行数'函数功能：获得指定部件或模块代码数。包括申明及代码，但不含注释代码行及空白行PublicFunctionCodeLinesInVBComp(CompsNameOrIndex)AsLongDimVBProjAsVBProjectDimVBCompAsVBComponentDimCodeModAsCodeModuleDimIAsLongDimstrCodeAsStringDimLineCountAsLong'实例化对象SetVBProj=VBProjectSetVBComp=onents(CompsNameOrIndex)SetCodeMod=duleWithCodeMod'循环每行代码ForI=fLines'将代码赋值给字符串变量strCode=.Lines(I,1)IfTrim(strCode)=vbNullStringOrLeft(Trim(strCode),1)=Chr(39)Then'跳过空行注释行ElseLineCount=LineCount+1EndIfNextIEndWith'获取实际代码计数输出CodeLinesInVBComp=LineCountEndFunction'******************************************************************'调用示例：获得部件"bas_ProcInfo"模块中实际代码行数odeLinesInVBComp("bas_ProcInfo")6.7获取工程代码行数信息6.7.1工程总代码行数'函数功能：工程总代码行数(含空及注释)'调用：TotalCodeLinesInVBCompPublicFunctionTotalCodeLinesInProject()AsLongDimVBProjAsVBProject

DimVBCompDimLineCountAsVBComponentAsLongSetVBProj=VBProject'判断工程是否锁定，则退出函数,tion=vbext_pp_lockedThenTotalCodeLinesInProject=-1ExitFunctionEndIf'遍历当前工程中所有部件onentsLineCount=LineCount+TotalCodeLinesInVBComp()NextVBCompTotalCodeLinesInProject=LineCountEndFunction6.7.2工程实际代码行数'函数功能：工程实际代码行数(不含空及注释)'调用：CodeLinesInVBCompPublicFunctionCodeLinesInProject()AsLongDimVBProjAsVBProjectDimVBCompAsVBComponentDimLineCountAsLongSetVBProj=VBProject'遍历当前工程中所有部件对象onentsLineCount=LineCount+CodeLinesInVBComp()NextVBCompCodeLinesInProject=LineCountEndFunction6.8代码模块中添加代码操作6.8.1向指定部件添加一行代码'过程功能：向指定部件或模块添加代码'输入参数：strNewCode（字符串）添加的代码字符串'VBCompNameOrIndex(Variant)可选参数，部件名或索引SubAddNewCodeInComps(ByValstrNewCodeAsString,_OptionalVBCompNameOrIndexAsVariant)DimVBProjAsVBProject

DimVBCodeModuleAsCodeModuleSetVBProj=VBProject'如不指定部件或模块，及为当前窗格部件代码模块IfVBCompNameOrIndex=""ThenSetVBCodeModule=duleElseSetVBCodeModule=onents(VBCompNameOrIndex).CodeModuleEndIf'向模块中添加新代码mStringstrNewCodeEndSub'*********************************************************'调用示例：向指定部件“模块1”，添加代码DimstrNewCodeAsStringstrNewCode="SubTest()"&vbLf&_Space(4)&"Msgbox"&Chr(34)&"这是添加的代码！"&Chr(34)&vbLf&_"EndSub"CallAddNewCodeInComps(strNewCode,"模块1")6.9代码模块中插入代码操作6.9.1在某个部件指定行插入一行或多行代码过程'过程功能：在代码模块的某个指定行，插入一行或多行的代码'输入参数：strNewCode（字符串）添加的代码字符串'CodeLines(长整型)代码行'VBCompNameOrIndex(Variant)部件名或索引SubInsertCodeInComps(ByValstrNewCodeAsString,_OptionalCodeLinesAsLong=1,_OptionalVBCompNameOrIndexAsVariant)DimVBProjAsVBProjectDimVBCodeModuleAsCodeModuleSetVBProj=VBProject'如不指定部件代码模块，及为当前窗格部件代码模块IfVBCompNameOrIndex=""ThenSetVBCodeModule=duleElseSetVBCodeModule=onents(VBCompNameOrIndex).CodeModuleEndIf'向模块中指定行插入或添加新代码

LinesCodeLines,strNewCodeEndSub'*********************************************************'调用示例：向指定部件“模块1”，第一第二行分别插入指定代码DimstrNewCode1,strNewCode2AsStringstrNewCode1="OptionCompareDatabase"strNewCode2="OptionExplicit"CallInsertCodeInComps(strNewCode1,,"模块1")CallInsertCodeInComps(strNewCode2,2,"模块1")6.10代码模块中替换代码操作6.10.1替换指定行原代码'过程功能：用新代码替换指定行原代码'输入参数：strNewCode（字符串）欲替换写入的新代码字符串'CodeLines(长整型)欲替换的代码行'VBCompNameOrIndex(Variant)部件名或索引SubReplaceLineCodeInComps(ByValstrNewCodeAsString,_OptionalCodeLinesAsLong=1,_OptionalVBCompNameOrIndexAsVariant)DimVBProjAsVBProjectDimVBCodeModuleAsCodeModuleSetVBProj=VBProject'如不指定部件或模块，及为当前窗格部件代码模块IfVBCompNameOrIndex=""ThenSetVBCodeModule=duleElseSetVBCodeModule=onents(VBCompNameOrIndex).CodeModuleEndIf'替换模块中指定行为新代码eLineCodeLines,strNewCodeEndSub'*********************************************************'调用示例：向指定部件“模块1”，替换原第五行代码为新代码DimstrNewCodeAsStringstrNewCode=Space(4)&"Msgbox"&Chr(34)&"这是替换的代码！"CallReplaceLineCodeInComps(strNewCode,5,"模块1")

6.11代码模块中删除代码操作6.11.1删除指定行代码'过程功能：删除指定行代码'输入参数：VBCompName(String字符串变量)指定模块名'StartLine代码起始行'LinesNum代码行数,默认为一行SubDelLinesCodes(VBCompNameAsString,StartLineAsLong,_OptionalLinesNumAsLong=1)DimVBProjAsVBProjectDimVBCompsAsVBComponentsSetVBProj=VBProjectSetVBComps=onentsVBComps(VBCompName).LinesStartLine,LinesNumEndSub'******************************************************************'调用示例一：删除"模块1"中，第一行代码CallDelLinesCodes("模块1",1)'******************************************************************'调用示例二：删除"模块1"中，从第一行到第十行代码CAllDelLinesCodes("模块1",1,10)6.11.2删除指定过程所有代码'删除指定过程代码PublicSubDelProcCodes(VBCompNameAsString,VBProcNameAsString)DimVBProjAsVBProjectDimVBCompsAsVBComponentsDimProcKindAsvbext_ProcKindSetVBProj=VBProjectSetVBComps=onentsWithVBComps(VBCompName).artLine(VBProcName,ProcKind),_.ProcCountLines(VBProcName,ProcKind)EndWithEndSub'******************************************************************'调用示例：删除“模块1”中，“我的过程”所有代码CallDelProcCodes("模块1","我的过程")6.11.3删除部件或模块中所有代码

'删除指定模块中所有代码PublicSubDelVBCompCodes(ByValVBCompNameAsString)DimVBProjAsVBProjectDimVBCompsAsVBComponents'实例对象SetVBProj=VBProjectSetVBComps=onents'从代码模块中第一行到最后一行执行删除VBComps(VBCompName).Lines1,_VBComps(VBCompName).fLinesEndSub'******************************************************************'调用示例：删除“模块1”中所有代码CallDelVBCompCodes("模块1")6.12添加事件过程代码操作6.12.1向指定部件对象添加事件'过程功能：创建一个事件过程'输入参数：VBCompNameOrIndex（Variant）部件名或索引'strEventProc(String)事件程序'strEventObj(String)事件对象'strInsertCode(String)事件中欲插入代码,默认为空SubCreateEventProcCode(VBCompNameOrIndexAsVariant,_strEventProcAsString,_strEventObjAsString,_OptionalstrInsertCodeAsString="")DimVBProjAsVBProjectDimVBCompAsVBComponentDimCodeModAsCodeModuleDimLineNumAsLong'实例化对象SetVBProj=VBProjectSetVBComp=onents(VBCompNameOrIndex)SetCodeMod=duleWithCodeModLineNum=.CreateEventProc(strEventProc,strEventObj)'是否为事件添了代码，如未添加则退出IfstrInsertCode=vbNullStringThenExitSub'从事件代码之后插入新代码

LineNum=LineNum+LinesLineNum,strInsertCodeEndWithEndSub'************************************************'调用示例一：在窗体1中创建窗体加载事件,并加入代码DimstrProcCodeAsStringstrProcCode=Space(4)&"Msgbox"&Chr(34)&"这是创建事件代码演示！"CallCreateEventProcCode("Form_窗体1","Load","Form",strProcCode)'************************************************'调用示例二：在窗体1中创建窗体打开事件,但不加入代码CallCreateEventProcCode("Form_窗体1","Open","Form")6.13查找代码获取相关信息6.13.1查找代码文本获取起止行列与是否存在信息'查找代码文本信息定义数据类型PublicTypeFindCodeInfoSLineAsLong'起始行ELineAsLong'结束行SColAsLong'起始列EColAsLong'结束列BooFoundAsBoolean'是否找到EndType'函数功能：搜索模块中代码文本自定义函数FunctionSearchCodeModule(ByValVBCompNameOrIndexAsVariant,_ByValstrFindCodeAsString)AsFindCodeInfoDimVBProjAsVBProjectDimVBCompAsVBComponentDimCodeModAsCodeModuleDimFindcodeAsFindCodeInfo'自定义数据类型DimSLAsLong'起始行DimSCAsLong'起始列DimELAsLong'结束行DimECAsLong'结束列DimFoundAsBoolean'查找是否存在'实例对象SetVBProj=VBProjectSetVBComp=onents(VBCompNameOrIndex)SetCodeMod=dule

WithCodeMod'初始起始行列值SL=1:SC=1'初始结束行列值EL=.CountOfLines:EC=255'开始查找Found=.Find(strFindCode,SL,SC,EL,EC,True,False,False)'如未找到继续查找DoUntilFound==SL:.SCol==EL:.ECol=nd=FoundEndWithEL=.CountOfLines:SC=EC+1:EC=255Found=.Find(strFindCode,SL,SC,EL,EC,True,False,False)LoopEndWith'赋值输出SearchCodeModule=FindcodeEndFunction'***************************************************'调用示例：查找模块"bas_ProcInfo"中"程序申明行"文本，并获取相关信息DimFindInfoAsFindCodeInfo'申明自定义数据类型'查找并赋值给自定义数据类型变量FindInfo=SearchCodeModule("bas_ProcInfo","程序申明行")MsgBox"查找文件："&nd&vbLf&_"起始行："&&vbLf&_"起始列："&&vbLf&_"结束行："&&vbLf&_"结束列："&以上为本人研究关于VBA扩展类库在二次开发中的一点心得，现将其汇集成文与大家分享。上述文字中的代码并不能算最优化，也未囊括VBA扩展类库中对象所有属性、方法，但对于解决二次开发中可能遇到的大多数问题还是很有帮助的。因为，成文较仓促，再则部分代码并未经过细致测试，不免有错漏之处，还请各位看文者帮助斧正，并告知本人，在此谢过。因篇幅考虑，部分代码并未收入文中，大家可参看实例，文中“代码实例”可在本人专栏或AccessHome论坛下载。