VBA 操作 VBE

VBA 操作 VBEIntroduction modules orprocedures Thisiscalled

Introduction

You can write code in VBA that reads or modifies other VBA projects, modules, or procedures. This is called extensibility because extends the editor — you can used VBA code to create new VBA code. You can use these features to write custom procedures that create, change, or delete VBA modules and code procedures.

In order to use the code on this page in your projects, you must change two settings.

  • First, you need to set an reference to the VBA Extensibililty library. The library contains the definitions of the objects that make up the VBProject. In the VBA editor, go the the Tools menu and choose References. In that dialog, scroll down to and check the entry for Microsoft Visual Basic For Applications Extensibility 5.3. If you do not set this reference, you will receive a User-defined type not defined compiler error.



  • Next, you need to enable programmatic access to the VBA Project. In Excel 2003 and earlier, go the Tools menu (in Excel, not in the VBA editor), choose Macros and then the Security item. In that dialog, click on the Trusted Publishers tab and check the Trust access to the Visual Basic Project setting.

    In Excel 2007, click the Developer item on the main Ribbon and then click the Macro Security item in the Code panel. In that dialog, choose Macro Settings and check the Trust access to the VBA project object model.




CAUTION: Many VBA-based computer viruses propagate themselves by creating and/or modifying VBA code. Therefore, many virus scanners may automatically and without warning or confirmation delete modules that reference the VBProject object, causing a permanent and irretrievable loss of code. Consult the documentation for your anti-virus software for details.

Operations Described On This Page

 

Objects In The VBA Extensibility Model

The following is a list of the more common objects that are used in the VBA Extensibilty object model. This is not a comprehensive list, but will be sufficient for the tasks at hand.

VBIDE
The VBIDE is the object library that defines all the objects and values that make up VBProject and the Visual Basic Editor. You must reference this library to use the VBA Extensibility objects. To add this reference, open the VBA editor, open your VBProject in the editor, and go to the Tools menu. There, choose References . In the References dialog, scroll down to Microsoft Visual Basic for Applications Extensibility 5.3 and check that item in the list. You can add the reference programmatically with code like:

 ThisWorkbook.VBProject.References.AddFromGuid _ GUID:="{0002E157-0000-0000-C000-000000000046}", _ Major:=5, Minor:=3 

VBE
The VBE refers to the Visual Basic Editor, which includes all the windows and projects that make up the editor.

VBProject
A VBProject contains all the code modules and components of a single workbook. One workbook has exactly one VBProject. The VBProject is made up of 1 or more VBComponent objects.

VBComponent
A VBComponent is one object within the VBProject. A VBComponent is a code module, a UserForm, a class module, one of the Sheet modules, or the ThisWorkbook module (together, the Sheet modules and the ThisWorkbook module are called Document Type modules.. A VBComponent is of one of the following types, identified by the Type property. The following constants are used to identify the Type. The numeric value of each constant is shown in parentheses.












  • vbext_ct_ClassModule (2): A class module to create your own objects. See Class Modules for details about classes and objects.
  • vbext_ct_Document (100): One of the Sheet modules or the ThisWorkbook module.
  • vbext_ct_MSForm (3): A UserForm. The visual component of a UserForm in the VBA Editor is called a designer.
  • vbext_ct_StdModule (1): A regular code module. Most of the procedures on this page will work with these types of components.


CodeModule
A CodeModule is the VBA source code of a VBComponent. You use the CodeModule object to access the code associated with a VBComponent. A VBComponent has exactly one CodeModule.

CodePane
A CodePane is an open editing window of a CodeModule.








 

Referencing VBIDE Objects

The code below illustrate various ways to reference Extensibility objects.

Dim VBAEditor As VBIDE.VBE Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Set VBAEditor = Application.VBE ''''''''''''''''''''''''''''''''''''''''''' Set VBProj = VBAEditor.ActiveVBProject ' or Set VBProj = Application.Workbooks("Book1.xls").VBProject ''''''''''''''''''''''''''''''''''''''''''' Set VBComp = ActiveWorkbook.VBProject.VBComponents("Module1") ' or Set VBComp = VBProj.VBComponents("Module1") ''''''''''''''''''''''''''''''''''''''''''' Set CodeMod = ActiveWorkbook.VBProject.VBComponents("Module1").CodeModule ' or Set CodeMod = VBComp.CodeModule 

 

In the code and descriptions on this page, the term Procedure means a Sub, Function, Property Get, Property Let, or Property Set procedure. The Extensibility library defines four procedures types, identified by the following constants. The numeric value of each constant is shown within parentheses.

  • vbext_pk_Get (3). A Property Get procedure.
  • vbext_pk_Let (1). A Property Let procedure.
  • vbext_pk_Set (2). A Property Set procedure.
  • vbext_pk_Proc (0). A Sub or Function procedure.

The rest of this page describes various procedures that modify the various objects of a VBProject.

Ensuring The Editor In Synchronized

The VBA editor is said to be “in sync” if the ActiveVBProject is the same as the VBProject that contains the ActiveCodePane. If you have two or more projects open within the VBA editor, it is possible to have an active code pane open from Project1 and have a component of Project2 selected in the Project Explorer window. In this case, the Application.VBE.ActiveVBProject is the project that is selected in the Project window, while Application.VBE.ActiveCodePane is a different project, specifically the project referenced by Application.VBE.ActiveCodePane.CodeModule.Parent.Collection.Parent.

You can test whether the editor in in sync with code like the following.

Function IsEditorInSync() As Boolean '======================================================================= ' IsEditorInSync ' This tests if the VBProject selected in the Project window, and ' therefore the ActiveVBProject is the same as the VBProject associated ' with the ActiveCodePane. If these two VBProjects are the same, ' the editor is in sync and the result is True. If these are not the ' same project, the editor is out of sync and the result is True. '======================================================================= With Application.VBE IsEditorInSync = .ActiveVBProject Is _ .ActiveCodePane.CodeModule.Parent.Collection.Parent End With End Function 

You can force synchronization with code like the following. This will set the ActiveVBProject to the project associated with the ActiveCodePane.

Sub SyncVBAEditor() '======================================================================= ' SyncVBAEditor ' This syncs the editor with respect to the ActiveVBProject and the ' VBProject containing the ActiveCodePane. This makes the project ' that conrains the ActiveCodePane the ActiveVBProject. '======================================================================= With Application.VBE If Not .ActiveCodePane Is Nothing Then Set .ActiveVBProject = .ActiveCodePane.CodeModule.Parent.Collection.Parent End If End With End Sub 

 

Adding A Module To A Project

This code will add new code module named NewModule to the VBProject of the active workbook. The type of VBComponent is specified by the value of the parameter passed to the Add method.



 Sub AddModuleToProject() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule) VBComp.Name = "NewModule" End Sub 

 

Adding A Procedure To A Module

This code will add a simple “Hello World” procedure named SayHello to the end of the module named Module1.



 Sub AddProcedureToModule() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Dim LineNum As Long Const DQUOTE = """" ' one " character Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents("Module1") Set CodeMod = VBComp.CodeModule With CodeMod LineNum = .CountOfLines + 1 .InsertLines LineNum, "Public Sub SayHello()" LineNum = LineNum + 1 .InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE LineNum = LineNum + 1 .InsertLines LineNum, "End Sub" End With End Sub 

 

Copy A Module From One Project To Another

There is no direct way to copy a module from one project to another. To accomplish this task, you must export the module from the Source VBProject and then import that file into the Destination VBProject. The code below will do this. The function declaration is:

Function CopyModule(ModuleName As String, _ FromVBProject As VBIDE.VBProject, _ ToVBProject As VBIDE.VBProject, _ OverwriteExisting As Boolean) As Boolean 

ModuleName is the name of the module you want to copy from one project to another.

FromVBProject is the VBProject that contains the module to be copied. This is the source VBProject.

ToVBProject is the VBProject in to which the module is to be copied. This is the destination VBProject.

OverwriteExisting indicates what to do if ModuleName already exists in the ToVBProject. If this is True the existing VBComponent will be removed from the ToVBProject. If this is False and the VBComponent already exists, the function does nothing and returns False.

The function returns True if successful or False is an error occurs. The function will return False if any of the following are true:













  • FromVBProject is nothing.
  • ToVBProject is nothing.
  • ModuleName is blank.
  • FromVBProject is locked.
  • ToVBProject is locked.
  • ModuleName does not exist in FromVBProject.
  • ModuleName exists in ToVBProject and OverwriteExisting is False.

The complete code is shown below:

Function CopyModule(ModuleName As String, _ FromVBProject As VBIDE.VBProject, _ ToVBProject As VBIDE.VBProject, _ OverwriteExisting As Boolean) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' CopyModule ' This function copies a module from one VBProject to ' another. It returns True if successful or False ' if an error occurs. ' ' Parameters: ' -------------------------------- ' FromVBProject The VBProject that contains the module ' to be copied. ' ' ToVBProject The VBProject into which the module is ' to be copied. ' ' ModuleName The name of the module to copy. ' ' OverwriteExisting If True, the VBComponent named ModuleName ' in ToVBProject will be removed before ' importing the module. If False and ' a VBComponent named ModuleName exists ' in ToVBProject, the code will return ' False. ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim VBComp As VBIDE.VBComponent Dim FName As String Dim CompName As String Dim S As String Dim SlashPos As Long Dim ExtPos As Long Dim TempVBComp As VBIDE.VBComponent ''''''''''''''''''''''''''''''''''''''''''''' ' Do some housekeeping validation. ''''''''''''''''''''''''''''''''''''''''''''' If FromVBProject Is Nothing Then CopyModule = False Exit Function End If If Trim(ModuleName) = vbNullString Then CopyModule = False Exit Function End If If ToVBProject Is Nothing Then CopyModule = False Exit Function End If If FromVBProject.Protection = vbext_pp_locked Then CopyModule = False Exit Function End If If ToVBProject.Protection = vbext_pp_locked Then CopyModule = False Exit Function End If On Error Resume Next Set VBComp = FromVBProject.VBComponents(ModuleName) If Err.Number <> 0 Then CopyModule = False Exit Function End If '''''''''''''''''''''''''''''''''''''''''''''''''''' ' FName is the name of the temporary file to be ' used in the Export/Import code. '''''''''''''''''''''''''''''''''''''''''''''''''''' FName = Environ("Temp") & "\" & ModuleName & ".bas" If OverwriteExisting = True Then '''''''''''''''''''''''''''''''''''''' ' If OverwriteExisting is True, Kill ' the existing temp file and remove ' the existing VBComponent from the ' ToVBProject. '''''''''''''''''''''''''''''''''''''' If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then Err.Clear Kill FName If Err.Number <> 0 Then CopyModule = False Exit Function End If End If With ToVBProject.VBComponents .Remove .Item(ModuleName) End With Else ''''''''''''''''''''''''''''''''''''''''' ' OverwriteExisting is False. If there is ' already a VBComponent named ModuleName, ' exit with a return code of False. '''''''''''''''''''''''''''''''''''''''''' Err.Clear Set VBComp = ToVBProject.VBComponents(ModuleName) If Err.Number <> 0 Then If Err.Number = 9 Then ' module doesn't exist. ignore error. Else ' other error. get out with return value of False CopyModule = False Exit Function End If End If End If '''''''''''''''''''''''''''''''''''''''''''''''''''' ' Do the Export and Import operation using FName ' and then Kill FName. '''''''''''''''''''''''''''''''''''''''''''''''''''' FromVBProject.VBComponents(ModuleName).Export Filename:=FName ''''''''''''''''''''''''''''''''''''' ' Extract the module name from the ' export file name. ''''''''''''''''''''''''''''''''''''' SlashPos = InStrRev(FName, "\") ExtPos = InStrRev(FName, ".") CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1) '''''''''''''''''''''''''''''''''''''''''''''' ' Document modules (SheetX and ThisWorkbook) ' cannot be removed. So, if we are working with ' a document object, delete all code in that ' component and add the lines of FName ' back in to the module. '''''''''''''''''''''''''''''''''''''''''''''' Set VBComp = Nothing Set VBComp = ToVBProject.VBComponents(CompName) If VBComp Is Nothing Then ToVBProject.VBComponents.Import Filename:=FName Else If VBComp.Type = vbext_ct_Document Then ' VBComp is destination module Set TempVBComp = ToVBProject.VBComponents.Import(FName) ' TempVBComp is source module With VBComp.CodeModule .DeleteLines 1, .CountOfLines S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines) .InsertLines 1, S End With On Error GoTo 0 ToVBProject.VBComponents.Remove TempVBComp End If End If Kill FName CopyModule = True End Function 

 

Creating An Event Procedure

This code will create a Workbook_Open event procedure. When creating an event procedure, you should use the CreateEventProc method so that the correct procedure declaration and parameter list is used. CreateEventProc will create the declaration line and the end of procedure line. It returns the line number on which the event procedure begins.



 Sub CreateEventProcedure() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Dim LineNum As Long Const DQUOTE = """" ' one " character  Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents("ThisWorkbook") Set CodeMod = VBComp.CodeModule With CodeMod LineNum = .CreateEventProc("Open", "Workbook") LineNum = LineNum + 1 .InsertLines LineNum, " MsgBox " & DQUOTE & "Hello World" & DQUOTE End With End Sub 

 

Deleting A Module From A Project

This code will delete Module1 from the VBProject. Note that you cannot remove any of the Sheet modules or the ThisWorkbook module. In general, you cannot delete a module whose Type is vbext_ct_Document.



 Sub DeleteModule() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents("Module1") VBProj.VBComponents.Remove VBComp End Sub 

 

Deleting A Procedure From A Module

This code will delete the procedure DeleteThisProc from the Module1. You must specify the procedure type in order to differentiate between Property Get, Property Let, and Property Set procedure, all of which have the same name.

 Sub DeleteProcedureFromModule() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Dim StartLine As Long Dim NumLines As Long Dim ProcName As String Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents("Module1") Set CodeMod = VBComp.CodeModule ProcName = "DeleteThisProc" With CodeMod StartLine = .ProcStartLine(ProcName, vbext_pk_Proc) NumLines = .ProcCountLines(ProcName, vbext_pk_Proc) .DeleteLines StartLine:=StartLine, Count:=NumLines End With End Sub 

 

Deleting All VBA Code In A Project

 Sub DeleteAllVBACode() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Set VBProj = ActiveWorkbook.VBProject For Each VBComp In VBProj.VBComponents If VBComp.Type = vbext_ct_Document Then Set CodeMod = VBComp.CodeModule With CodeMod .DeleteLines 1, .CountOfLines End With Else VBProj.VBComponents.Remove VBComp End If Next VBComp End Sub 

 

Eliminating Screen Flicker During VBProject Code

 Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal ClassName As String, ByVal WindowName As String) As Long Private Declare Function LockWindowUpdate Lib "user32" _ (ByVal hWndLock As Long) As Long Sub EliminateScreenFlicker() Dim VBEHwnd As Long On Error GoTo ErrH: Application.VBE.MainWindow.Visible = False VBEHwnd = FindWindow("wndclass_desked_gsk", _ Application.VBE.MainWindow.Caption) If VBEHwnd Then LockWindowUpdate VBEHwnd End If ''''''''''''''''''''''''' ' your code here ''''''''''''''''''''''''' Application.VBE.MainWindow.Visible = False ErrH: LockWindowUpdate 0& End Sub 

 

Exporting A VBComponent Code Module To A Text File

You can export an existing VBComponent CodeModule to a text file. This can be useful if you are archiving modules to create a library of useful module to be used in other projects.

 Public Function ExportVBComponent(VBComp As VBIDE.VBComponent, _ FolderName As String, _ Optional FileName As String, _ Optional OverwriteExisting As Boolean = True) As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This function exports the code module of a VBComponent to a text ' file. If FileName is missing, the code will be exported to ' a file with the same name as the VBComponent followed by the ' appropriate extension. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Extension As String Dim FName As String Extension = GetFileExtension(VBComp:=VBComp) If Trim(FileName) = vbNullString Then FName = VBComp.Name & Extension Else FName = FileName If InStr(1, FName, ".", vbBinaryCompare) = 0 Then FName = FName & Extension End If End If If StrComp(Right(FolderName, 1), "\", vbBinaryCompare) = 0 Then FName = FolderName & FName Else FName = FolderName & "\" & FName End If If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then If OverwriteExisting = True Then Kill FName Else ExportVBComponent = False Exit Function End If End If VBComp.Export FileName:=FName ExportVBComponent = True End Function Public Function GetFileExtension(VBComp As VBIDE.VBComponent) As String ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This returns the appropriate file extension based on the Type of ' the VBComponent. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 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 Select End Function 

 

Listing All Modules In A Project

This code will list all the modules and their types in the workbook, starting the listing in cell A1.

 Sub ListModules() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim WS As Worksheet Dim Rng As Range Set VBProj = ActiveWorkbook.VBProject Set WS = ActiveWorkbook.Worksheets("Sheet1") Set Rng = WS.Range("A1") For Each VBComp In VBProj.VBComponents Rng(1, 1).Value = VBComp.Name Rng(1, 2).Value = ComponentTypeToString(VBComp.Type) Set Rng = Rng(2, 1) Next VBComp End Sub Function ComponentTypeToString(ComponentType As VBIDE.vbext_ComponentType) As String Select Case ComponentType Case vbext_ct_ActiveXDesigner ComponentTypeToString = "ActiveX Designer" Case vbext_ct_ClassModule ComponentTypeToString = "Class Module" Case vbext_ct_Document ComponentTypeToString = "Document Module" Case vbext_ct_MSForm ComponentTypeToString = "UserForm" Case vbext_ct_StdModule ComponentTypeToString = "Code Module" Case Else ComponentTypeToString = "Unknown Type: " & CStr(ComponentType) End Select End Function 

 

Listing All Procedures In A Module

This code will list all the procedures in Module1, beginning the listing in cell A1.

 Sub ListProcedures() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Dim LineNum As Long Dim NumLines As Long Dim WS As Worksheet Dim Rng As Range Dim ProcName As String Dim ProcKind As VBIDE.vbext_ProcKind Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents("Module1") Set CodeMod = VBComp.CodeModule Set WS = ActiveWorkbook.Worksheets("Sheet1") Set Rng = WS.Range("A1") With CodeMod LineNum = .CountOfDeclarationLines + 1 Do Until LineNum >= .CountOfLines ProcName = .ProcOfLine(LineNum, ProcKind) Rng.Value = ProcName Rng(1, 2).Value = ProcKindString(ProcKind) LineNum = .ProcStartLine(ProcName, ProcKind) + _ .ProcCountLines(ProcName, ProcKind) + 1 Set Rng = Rng(2, 1) Loop End With End Sub Function ProcKindString(ProcKind As VBIDE.vbext_ProcKind) As String Select Case ProcKind Case vbext_pk_Get ProcKindString = "Property Get" Case vbext_pk_Let ProcKindString = "Property Let" Case vbext_pk_Set ProcKindString = "Property Set" Case vbext_pk_Proc ProcKindString = "Sub Or Function" Case Else ProcKindString = "Unknown Type: " & CStr(ProcKind) End Select End Function 

 

General Infomation About A Procedure

The code below returns the following information about a procedure in a module, loaded into the ProcInfo Type. The function ProcedureInfo takes as input then name of the procedure, a VBIDE.vbext_ProcKind procedure type, and a reference to the CodeModule object containing the procedure.



 Public Enum ProcScope ScopePrivate = 1 ScopePublic = 2 ScopeFriend = 3 ScopeDefault = 4 End Enum Public Enum LineSplits LineSplitRemove = 0 LineSplitKeep = 1 LineSplitConvert = 2 End Enum Public Type ProcInfo ProcName As String ProcKind As VBIDE.vbext_ProcKind ProcStartLine As Long ProcBodyLine As Long ProcCountLines As Long ProcScope As ProcScope ProcDeclaration As String End Type Function ProcedureInfo(ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _ CodeMod As VBIDE.CodeModule) As ProcInfo Dim PInfo As ProcInfo Dim BodyLine As Long Dim Declaration As String Dim FirstLine As String BodyLine = CodeMod.ProcStartLine(ProcName, ProcKind) If BodyLine > 0 Then With CodeMod PInfo.ProcName = ProcName PInfo.ProcKind = ProcKind PInfo.ProcBodyLine = .ProcBodyLine(ProcName, ProcKind) PInfo.ProcCountLines = .ProcCountLines(ProcName, ProcKind) PInfo.ProcStartLine = .ProcStartLine(ProcName, ProcKind) FirstLine = .Lines(PInfo.ProcBodyLine, 1) If StrComp(Left(FirstLine, Len("Public")), "Public", vbBinaryCompare) = 0 Then PInfo.ProcScope = ScopePublic ElseIf StrComp(Left(FirstLine, Len("Private")), "Private", vbBinaryCompare) = 0 Then PInfo.ProcScope = ScopePrivate ElseIf StrComp(Left(FirstLine, Len("Friend")), "Friend", vbBinaryCompare) = 0 Then PInfo.ProcScope = ScopeFriend Else PInfo.ProcScope = ScopeDefault End If PInfo.ProcDeclaration = GetProcedureDeclaration(CodeMod, ProcName, ProcKind, LineSplitKeep) End With End If ProcedureInfo = PInfo End Function Public Function GetProcedureDeclaration(CodeMod As VBIDE.CodeModule, _ ProcName As String, ProcKind As VBIDE.vbext_ProcKind, _ Optional LineSplitBehavior As LineSplits = LineSplitRemove) ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' GetProcedureDeclaration ' This return the procedure declaration of ProcName in CodeMod. The LineSplitBehavior ' determines what to do with procedure declaration that span more than one line using ' the "_" line continuation character. If LineSplitBehavior is LineSplitRemove, the ' entire procedure declaration is converted to a single line of text. If ' LineSplitBehavior is LineSplitKeep the "_" characters are retained and the ' declaration is split with vbNewLine into multiple lines. If LineSplitBehavior is ' LineSplitConvert, the "_" characters are removed and replaced with vbNewLine. ' The function returns vbNullString if the procedure could not be found. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim LineNum As Long Dim S As String Dim Declaration As String On Error Resume Next LineNum = CodeMod.ProcBodyLine(ProcName, ProcKind) If Err.Number <> 0 Then Exit Function End If S = CodeMod.Lines(LineNum, 1) Do While Right(S, 1) = "_" Select Case True Case LineSplitBehavior = LineSplitConvert S = Left(S, Len(S) - 1) & vbNewLine Case LineSplitBehavior = LineSplitKeep S = S & vbNewLine Case LineSplitBehavior = LineSplitRemove S = Left(S, Len(S) - 1) & " " End Select Declaration = Declaration & S LineNum = LineNum + 1 S = CodeMod.Lines(LineNum, 1) Loop Declaration = SingleSpace(Declaration & S) GetProcedureDeclaration = Declaration End Function Private Function SingleSpace(ByVal Text As String) As String Dim Pos As String Pos = InStr(1, Text, Space(2), vbBinaryCompare) Do Until Pos = 0 Text = Replace(Text, Space(2), Space(1)) Pos = InStr(1, Text, Space(2), vbBinaryCompare) Loop SingleSpace = Text End Function 


You can call the ProcedureInfo function using code like the following:


 Sub ShowProcedureInfo() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Dim CompName As String Dim ProcName As String Dim ProcKind As VBIDE.vbext_ProcKind Dim PInfo As ProcInfo CompName = "modVBECode" ProcName = "ProcedureInfo" ProcKind = vbext_pk_Proc Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents(CompName) Set CodeMod = VBComp.CodeModule PInfo = ProcedureInfo(ProcName, ProcKind, CodeMod) Debug.Print "ProcName: " & PInfo.ProcName Debug.Print "ProcKind: " & CStr(PInfo.ProcKind) Debug.Print "ProcStartLine: " & CStr(PInfo.ProcStartLine) Debug.Print "ProcBodyLine: " & CStr(PInfo.ProcBodyLine) Debug.Print "ProcCountLines: " & CStr(PInfo.ProcCountLines) Debug.Print "ProcScope: " & CStr(PInfo.ProcScope) Debug.Print "ProcDeclaration: " & PInfo.ProcDeclaration End Sub 

 

Searching For Text In A Module

The CodeModule object has a Find method that you can use to search for text within the code module. The Find method accepts ByRef Long parameters. Upon input, these parameters specify the range of lines and column to search. On output, these values will point to the found text. To find the second and subsequent occurence of the text, you need to set the parameters to refer to the text following the found line and column. The Find method returns True or False indicating whether the text was found. The code below will search all of the code in Module1 and print a Debug message for each found occurrence. Note the values set with the SL, SC, EL, and EC variables. The code loops until the Found variable is False.

 Sub SearchCodeModule() Dim VBProj As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim CodeMod As VBIDE.CodeModule Dim FindWhat As String Dim SL As Long ' start line Dim EL As Long ' end line Dim SC As Long ' start column Dim EC As Long ' end column Dim Found As Boolean Set VBProj = ActiveWorkbook.VBProject Set VBComp = VBProj.VBComponents("Module1") Set CodeMod = VBComp.CodeModule FindWhat = "findthis" With CodeMod SL = 1 EL = .CountOfLines SC = 1 EC = 255 Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _ EndLine:=EL, EndColumn:=EC, _ wholeword:=True, MatchCase:=False, patternsearch:=False) Do Until Found = False Debug.Print "Found at: Line: " & CStr(SL) & " Column: " & CStr(SC) EL = .CountOfLines SC = EC + 1 EC = 255 Found = .Find(target:=FindWhat, StartLine:=SL, StartColumn:=SC, _ EndLine:=EL, EndColumn:=EC, _ wholeword:=True, MatchCase:=False, patternsearch:=False) Loop End With End Sub 

 

Testing If A VBComponent Exists

This code will return True or False indicating whether the VBComponent named by VBCompName exists in the project referenced by VBProj. If VBProj is omitted, the VBProject of the ActiveWorkbook is used.

 Public Function VBComponentExists(VBCompName As String, Optional VBProj As VBIDE.VBProject = Nothing) As Boolean '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This returns True or False indicating whether a VBComponent named ' VBCompName exists in the VBProject referenced by VBProj. If VBProj ' is omitted, the VBProject of the ActiveWorkbook is used. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim VBP As VBIDE.VBProject If VBProj Is Nothing Then Set VBP = ActiveWorkbook.VBProject Else Set VBP = VBProj End If On Error Resume Next VBComponentExists = CBool(Len(VBP.VBComponents(VBCompName).Name)) End Function 

 

Total Code Lines In A Component Code Module

This function will return the total code lines in a VBComponent. It ignores blank lines and comment lines. It will return -1 if the project is locked.

 Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This returns the total number of code lines (excluding blank lines and ' comment lines) in the VBComponent referenced by VBComp. Returns -1 ' if the VBProject is locked. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim N As Long Dim S As String Dim LineCount As Long If VBComp.Collection.Parent.Protection = vbext_pp_locked Then TotalCodeLinesInVBComponent = -1 Exit Function End If With VBComp.CodeModule For N = 1 To .CountOfLines S = .Lines(N, 1) If Trim(S) = vbNullString Then ' blank line, skip it ElseIf Left(Trim(S), 1) = "'" Then ' comment line, skip it Else LineCount = LineCount + 1 End If Next N End With TotalCodeLinesInVBComponent = LineCount End Function 

 

Total Lines In A Project

This code will return the count of lines in all components of the project referenced by VBProj. If VBProj is omitted, the VBProject of the ActiveWorkbook is used. The function will return -1 if the project is locked.

 Public Function TotalLinesInProject(Optional VBProj As VBIDE.VBProject = Nothing) As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This returns the total number of lines in all components of the VBProject ' referenced by VBProj. If VBProj is missing, the VBProject of the ActiveWorkbook ' is used. Returns -1 if the VBProject is locked. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim VBP As VBIDE.VBProject Dim VBComp As VBIDE.VBComponent Dim LineCount As Long If VBProj Is Nothing Then Set VBP = ActiveWorkbook.VBProject Else Set VBP = VBProj End If If VBP.Protection = vbext_pp_locked Then TotalLinesInProject = -1 Exit Function End If For Each VBComp In VBP.VBComponents LineCount = LineCount + VBComp.CodeModule.CountOfLines Next VBComp TotalLinesInProject = LineCount End Function 

 

Total Code Lines In A Component

This function will return the total number of code lines in a VBComponent. It ignores blank lines and comment lines. It will return -1 if the project is locked.

 Public Function TotalCodeLinesInVBComponent(VBComp As VBIDE.VBComponent) As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This returns the total number of code lines (excluding blank lines and ' comment lines) in the VBComponent referenced by VBComp. Returns -1 ' if the VBProject is locked. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim N As Long Dim S As String Dim LineCount As Long If VBComp.Collection.Parent.Protection = vbext_pp_locked Then TotalCodeLinesInVBComponent = -1 Exit Function End If With VBComp.CodeModule For N = 1 To .CountOfLines S = .Lines(N, 1) If Trim(S) = vbNullString Then ' blank line, skip it ElseIf Left(Trim(S), 1) = "'" Then ' comment line, skip it Else LineCount = LineCount + 1 End If Next N End With TotalCodeLinesInVBComponent = LineCount End Function 

 

Total Code Lines In A Project

This function will return the total number of code lines in all the components of a VBProject. It ignores blank lines and comment lines. It will return -1 if the project is locked.

 Public Function TotalCodeLinesInProject(VBProj As VBIDE.VBProject) As Long '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' This returns the total number of code lines (excluding blank lines and ' comment lines) in all VBComponents of VBProj. Returns -1 if VBProj ' is locked. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim VBComp As VBIDE.VBComponent Dim LineCount As Long If VBProj.Protection = vbext_pp_locked Then TotalCodeLinesInProject = -1 Exit Function End If For Each VBComp In VBProj.VBComponents LineCount = LineCount + TotalCodeLinesInVBComponent(VBComp) Next VBComp TotalCodeLinesInProject = LineCount End Function 

Workbook Associated With A VBProject

The Workbook object provides a property named VBProject that allows you to reference to the VBProject associated with a workbook. However, the reverse is not true. There is no direct way to get a reference to the workbook that contains a specific VBProject. However, it can be done with some fairly simple code. The following function, WorkbookOfVBProject, will return a reference to the Workbook object that contains the VBProject indicated by the WhichVBP parameter. This parameter may be a VBIDE.VBProject object, or a string containing the name of the VBProject (the project name, not the workbook name), or a numeric index, indicating the ordinal index of the VBProject (its position in the list of VBProjects in the Project Explorer window). If the parameter is any object other than VBIDE.VBProject, the code raises an error 13 (type mismatch). If the parameter does not name an existing VBProject, the code raises an error 9 (subscript out of range). If you have more than one VBProject with the default name VBAProject, the code will return the first VBProject with that name.

Function WorkbookOfVBProject(WhichVBP As Variant) As Workbook ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' WorkbookOfVBProject ' This returns the Workbook object for a specified VBIDE.VBProject. ' The parameter WhichVBP can be any of the following: ' A VBIDE.VBProject object ' A string containing the name of the VBProject. ' The index number (ordinal position in Project window) of the VBProject. ' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim WB As Workbook Dim AI As AddIn Dim VBP As VBIDE.VBProject If IsObject(WhichVBP) = True Then ' If WhichVBP is an object, it must be of the ' type VBIDE.VBProject. Any other object type ' throws an error 13 (type mismatch). On Error GoTo 0 If TypeOf WhichVBP Is VBIDE.VBProject Then Set VBP = WhichVBP Else Err.Raise 13 End If Else On Error Resume Next Err.Clear ' Here, WhichVBP is either the string name of ' the VBP or its ordinal index number. Set VBP = Application.VBE.VBProjects(WhichVBP) On Error GoTo 0 If VBP Is Nothing Then Err.Raise 9 End If End If For Each WB In Workbooks If WB.VBProject Is VBP Then Set WorkbookOfVBProject = WB Exit Function End If Next WB ' not found in workbooks, search installed add-ins. For Each AI In Application.AddIns If AI.Installed = True Then If Workbooks(AI.Name).VBProject Is VBP Then Set WorkbookOfVBProject = Workbooks(AI.Name) Exit Function End If End If Next AI End Function 

转载于:https://www.cnblogs.com/lbnnbs/p/4784897.html

版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请联系我们举报,一经查实,本站将立刻删除。

发布者:全栈程序员-站长,转载请注明出处:https://javaforall.net/208269.html原文链接:https://javaforall.net

(0)
上一篇 2026年3月19日 上午11:58
下一篇 2026年3月19日 上午11:59


相关推荐

  • Redis介绍——Linux环境Redis安装全过程和遇到的问题及解决方案

    Redis介绍——Linux环境Redis安装全过程和遇到的问题及解决方案

    2022年2月26日
    38
  • java面试时怎么做自我介绍_面试时如何做好自我介绍「建议收藏」

    java面试时怎么做自我介绍_面试时如何做好自我介绍「建议收藏」该楼层疑似违规已被系统折叠隐藏此楼查看此楼要想让人力资源考官们欣赏你,你必须明确地告诉考官们你具有应考职位必需的能力与素质,而只有您对此有信心并表现出这种信心后,你才证明了自己。所以我们要充满自信的自我介绍,那面试时如何做自我介绍,敬请阅读下文,或许下文有您想要的答案!.1、自我介绍切忌话多。.比如说,有的面试要求每个人用三句话介绍自己,难道真的只能姓名+专业+学校了?求职者遇到这种情况,当然…

    2022年7月7日
    21
  • 超星尔雅学习通情商与智慧人生 答案 满分版

    超星尔雅学习通情商与智慧人生 答案 满分版1 6 章节测验 1 单选题 EQ 情商是个体的重要的生存能力 是一种挖掘 运用 影响生活各个层面和人生未来的关键的 因素 A 品质 B 格调 C 智力 D 品味我的答案 A2 单选题 情商即情绪 或情感 是个体重要的生存能力 是一个人 的完美体现 A 智力 系数 软实力 B 智慧 商数 软实力 C 智慧 系数 硬实力 D 智力 商数 硬实力我的答案 B3 单选题 在事业取得成功的过程中 靠的是智商 靠的是其他因素 其中最重要的是情商 良好的情商是你获得职场成功的基本素质

    2026年3月20日
    4
  • HDU-1498-50years,50colors(最大匹配, 枚举)

    HDU-1498-50years,50colors(最大匹配, 枚举)

    2021年7月6日
    88
  • 基本运算放大器原理「建议收藏」

    基本运算放大器原理「建议收藏」★运算放大器电路图标:Vp:同相输入端Vn:反向输入端Vo:输出端1.同相输入端与反向输入端的意义。 同相位 Vp Vn Vo 上升 接地或稳定的电平 上升 下降 接地或稳定的电平 下降 反相位 Vp…

    2022年4月28日
    52
  • 10道Hadoop面试真题及解题思路「建议收藏」

    10道Hadoop面试真题及解题思路「建议收藏」(一)海量日志数据,提取出某日访问百度次数最多的那个IP。首先是这一天,并且是访问百度的日志中的IP取出来,逐个写入到一个大文件中。注意到IP是32位的,最多有个2^32个IP。同样可以采用映射的方法,比如模1000,把整个大文件映射为1000个小文件,再找出每个小文中出现频率最大的IP(可以采用hash_map进行频率统计,然后再找出频率最大的几个)及相应的频率。然后再在这100

    2022年6月22日
    23

发表回复

您的邮箱地址不会被公开。 必填项已用 * 标注

关注全栈程序员社区公众号