Одно и то же имя константы в разных модулях - PullRequest
Новая
       20

Одно и то же имя константы в разных модулях

1 голос
/ 19 марта 2019

У меня есть многомодульный проект 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 »объект не поддерживает это свойство или метод

Что мне делать?

1 Ответ

1 голос
/ 19 марта 2019

Единственное, что я могу себе представить, - это проанализировать код в модуле и найти строку со словом 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

Обратите внимание, что в каждой строке разбирается только одно объявление.

...