动态添加函数后如何"sync" VB项目?



我正在编写一个Excel VBA项目,该项目在代码执行期间创建新函数。

新添加的功能需要能够立即执行。

虽然我确实看到了添加了新功能,但在第一次执行时收到"1004"运行时错误。

下面的代码将一个新的函数testMethod添加到现有的DynamicFunctions模块中(如果该函数尚不存在(并执行它。

代码片段取自动态代码生成和Execute@VBA以及编程 VBA 编辑器

错误消息: "运行时错误'1004': 无法运行宏"测试方法"。宏可能在此工作簿中不可用,或者所有宏都可能被禁用">

(请注意,在第二次执行时,函数已经在模块中,因此代码只需执行它并弹出消息框(

Dim code As String
code = "Public Function testMethod()" & vbNewLine & _
vbTab & "MsgBox """ & Time & """" & vbNewLine & _
"End Function"
Dim methodExist As Boolean
methodExist = checkProcName("testMethod")
If (methodExist = False) Then
Dim VBComp As VBIDE.VBComponent
Set VBComp = ThisWorkbook.VBProject.VBComponents("DynamicFunctions")
Call VBComp.CodeModule.AddFromString(code)
End If
Application.Run "testMethod"

Function checkProcName(sProcName As String) As Boolean
' ===========================================================================
' Found on http://www.cpearson.com at http://www.cpearson.com/excel/vbe.aspx
' then modified
'
' USAGE:
' to check if a procedure exists, call 'checkProcName' passing
' in the target workbook (which should be open), the Module,
' and the procedure name
'
' ===========================================================================
Dim oVBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim ProcName As String
Dim ProcKind As VBIDE.vbext_ProcKind
checkProcName = False
Set VBProj = ThisWorkbook.VBProject
Set VBComp = VBProj.VBComponents("DynamicFunctions")
Set CodeMod = VBComp.CodeModule
With CodeMod
LineNum = .CountOfDeclarationLines + 1
Do Until LineNum >= .CountOfLines
ProcName = .ProcOfLine(LineNum, ProcKind)
If ProcName = sProcName Then
checkProcName = True
Exit Do
End If
Debug.Print ProcName
LineNum = .ProcStartLine(ProcName, ProcKind) + .ProcCountLines(ProcName, ProcKind) + 1
Loop
End With

End Function

除非有特定原因需要在项目中安装DynamicFunctions模块,否则您可以随时创建一个,运行代码并在完成后删除。

Public Sub CreateModuleRunMethodAndDelete()
Dim code As String
code = "Public Function testMethod()" & vbNewLine & _
vbTab & "MsgBox """ & Time & """" & vbNewLine & _
"End Function"
'Create and append code
With ThisWorkbook.VBProject
With .VBComponents.Add(vbext_ct_StdModule)
.Name = "Temp"
.CodeModule.AddFromString code
End With
End With
'Run
Application.Run "testMethod"
'Delete module
With ThisWorkbook.VBProject
.VBComponents.Remove .VBComponents("Temp")
End With
End Sub

编辑:

如果不存在,则创建过程并运行。

Public Sub RunMethod()
Dim code As String
code = "Public Function testMethod()" & vbNewLine & _
vbTab & "MsgBox """ & Time & """" & vbNewLine & _
"End Function"
If Not checkProcName("testMethod") Then
ThisWorkbook.VBProject.VBComponents("DynamicFunctions").CodeModule.AddFromString code
End If
Application.Run "testMethod"
End Sub

最新更新