Question

我有一个多模块VBA项目，每个模块都包含具有不同值的相同常量。（我使用此常量定义模块的版本）

Option Explicit
Global Const ModuleVersion As String = "1.1.3"

然后在一个模块中，我要检查每个模块的版本：

Sub Test()

    Dim a As String    
    Dim objVBComp As VBComponent

    For Each objVBComp In ThisWorkbook.VBProject.VBComponents
        If objVBComp.Type = vbext_ct_StdModule Then
            a = objVBComp.ModuleVersion
        End If
    Next

End Sub

但是当我检查“ objVBComp.ModuleVersion”时，出现以下错误：

错误438“对象不支持此属性或方法

我该怎么办？

Answer 1

我唯一可以想象的是解析模块中的代码，并找到包含单词Const后跟ModuleVersion的行，例如：

Global Const ModuleVersion As String = "1.1.3"

然后从该行中提取1.1.3。

Option Explicit

Sub Test()
    Dim a As String
    Dim objVBComp As VBComponent

    For Each objVBComp In ThisWorkbook.VBProject.VBComponents
        If objVBComp.Type = vbext_ct_StdModule Then
            Debug.Print objVBComp.Name, GetConstValue(objVBComp.Name, "ModuleVersion")
        End If
    Next
End Sub

Function GetConstValue(ModuleName As String, ConstName As String) As Variant
    Dim Words As Variant
    Dim i As Long, j As Long
    Dim Result As Variant
    Dim LineFound As Boolean

    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
        For i = 1 To .CountOfDeclarationLines
            Words = Split(.Lines(i, 1), " ")
            For j = 0 To UBound(Words) - 1
                If Words(j) = "'" Or Words(j) = "Rem" Then Exit For
                If Words(j) = "Const" Then
                    If Words(j + 1) = ConstName Then
                        LineFound = True
                    End If
                End If
                If LineFound And Words(j) = "=" Then
                    If Left$(Words(j + 1), 1) = """" Then
                        Result = Mid$(Words(j + 1), 2, Len(Words(j + 1)) - 2)
                    Else
                        Result = Words(j + 1)
                    End If
                    GetConstValue = Result
                    Exit Function
                End If
            Next j
            If LineFound Then Exit Function
        Next i
    End With
End Function

请注意，这不会将值返回为正确的数据类型。虽然这将适用于您的版本字符串，但如果应读取正确的数据类型，则需要对其进行扩展：

Sub Test()
    Dim a As String
    Dim objVBComp As VBComponent

    For Each objVBComp In ThisWorkbook.VBProject.VBComponents
        If objVBComp.Type = vbext_ct_StdModule Then
            Dim ModuleVersion As Variant
            ModuleVersion = GetConstValue(objVBComp.Name, "ModuleVersion")
            Debug.Print objVBComp.Name, ModuleVersion, VarType(ModuleVersion)
        End If
    Next
End Sub

Function GetConstValue(ModuleName As String, ConstName As String) As Variant
    Dim Words As Variant
    Dim i As Long, j As Long
    Dim Result As Variant
    Dim LineFound As Boolean
    Dim DataType As String

    With ThisWorkbook.VBProject.VBComponents(ModuleName).CodeModule
        For i = 1 To .CountOfDeclarationLines
            Words = Split(.Lines(i, 1), " ")
            For j = 0 To UBound(Words) - 1
                If Words(j) = "'" Or Words(j) = "Rem" Then Exit For
                If Words(j) = "Const" Then
                    If Words(j + 1) = ConstName Then
                        LineFound = True
                    End If
                End If
                If LineFound Then
                    If Words(j) = "As" Then
                        DataType = Words(j + 1)
                    Else If Words(j) = "=" Then
                        Select Case LCase$(DataType) ' Byte, Boolean, Integer, Long, Currency, Single, Double, Decimal (currenty not supported), Date, String, Variant
                        Case "byte"
                            Result = CByte(Words(j + 1))
                        Case "boolean"
                            Result = CBool(Words(j + 1))
                        Case "integer"
                            Result = CInt(Words(j + 1))
                        Case "long"
                            Result = CLng(Words(j + 1))
                        Case "currency"
                            Result = CCur(Words(j + 1))
                        Case "single"
                            Result = CSng(Words(j + 1))
                        Case "double"
                            Result = CDbl(Words(j + 1))
                        Case "date"
                            Result = CDate(Words(j + 1))
                        Case "string"
                            Result = CStr(Mid$(Words(j + 1), 2, Len(Words(j + 1)) - 2)) 
                        Case Else 'variant
                            If Left$(Words(j + 1), 1) = """" Then
                                Result = CStr(Mid$(Words(j + 1), 2, Len(Words(j + 1)) - 2))
                            Else
                                Result = CVar(Words(j + 1))
                            End If
                        End Select

                        GetConstValue = Result
                        Exit Function
                    End If
                End If
            Next j
            If LineFound Then Exit Function
        Next i
    End With
End Function

请注意，每行仅解析一个声明。

不同模块中的常量名称相同

1 个答案: