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

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" 时，出现以下错误：

error 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

请注意，这不会 return 值作为正确的数据类型。虽然这适用于您的版本字符串，但如果应该读取正确的数据类型，您需要扩展它：

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

注意每行只解析一个声明。

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

Same constant Name in different modules

excel

vba

constants

vbe