Не может сделать сложный класс

Question

Я пытаюсь создать сложный класс со следующей структурой:

Obj {
    name {
        value = ""
        tag = "name"
    }
    id {
        value = ""
        tag = "id"
    }
    address {
        value = ""
        tag = "address"
    }
}

Сначала я создал класс RefPair, который выглядит следующим образом:

Public tag As String
Public value As String

Затем LawSubject класс, который выглядит следующим образом:

Public name As New RefPair
    name.tag = "name"

Public id As New RefPair
    id.tag = "id"

Public address As New RefPair
    address.tag = "address"

Когда я пытаюсь вызвать этот класс, я получаю сообщение об ошибке name.tag = "name" string: compile error: invalid outside procedure Что я делаю не так?

Answer 1

Вы пытаетесь установить свойство объекта, которое в VBA возможно только внутри процедуры. (Sub, Function или Property)

В качестве альтернативы вы можете переместить свои операторы let собственности в процедуру Class_Initialize:

Public name As New RefPair
Public id As New RefPair
Public address As New RefPair

Private Sub Class_Initialize()
    name.tag = "name"
    id.tag = "id"
    address.tag = "address"
End Sub

---

Но могу я предложить вам не делать этого? использовать модуль класса для хранения 2 строковых значений? Накладные расходы огромны. Вместо этого рассмотрите возможность использования Type:

Private Type RefPairType
  tag As String
  value As String
End Type

Private Name As RefPairType
Private Id As RefPairType
Private Address As RefPairType

Private Sub Class_Initialize()
    Name.tag = "name"
    Id.tag = "id"
    Address.tag = "address"
End Sub

Таким образом, вы можете инкапсулировать соответствующие данные для вашего класса, одновременно добиваясь лучшего контроля над процессом манипулирования внутренними значениями извне, предоставляя средства доступа к свойствам. Например:

Private Type RefPairType
    tag As String
    value As String
End Type

Private Type LawSubjectType
    Name As RefPairType
    Id As RefPairType
    Address As RefPairType
End Type

Private This As LawSubjectType

Private Sub Class_Initialize()
    With This
        .Name.tag = "name"
        .Id.tag = "id"
        .Address.tag = "address"
    End With
End Sub

' Allow outside code to get the value of the Name pair
Public Property Get NameValue() As String
    NameValue = This.Name.value
End Property

' Allow outside code to get the value of the ID pair
Public Property Get IdValue() As String
    IdValue = This.Id.value
End Property

' Allow outside code to get and modify the value of the Address pair
Public Property Get AddressValue() As String
    AddressValue = This.Address.value
End Property

Public Property Let AddressValue(val As String)
    This.Address.value = val
End Property

Answer 2

Вам нужен родительский объект LawSubject для хранения ссылок на дочерний объект RefPair. Реализация, наиболее близкая к вашему примеру в (которую я думаю C++?), Будет следующей:

Class: RefPair

Option Explicit

Private Type TRefPair
    Tag As String
    Value As String
End Type

Private this As TRefPair

Public Property Let Tag(ByVal Value As String)
    this.Tag = Value
End Property

Public Property Get Tag() As String
    Tag = this.Tag
End Property


Public Property Let Value(ByVal Value As String)
    this.Value = Value
End Property

Public Property Get Value() As String
    Value = this.Value
End Property

Class: LawSubject

Option Explicit

Private Type TLawSubject
    Name As New RefPair
    Id As New RefPair
    Address As New RefPair
End Type

Private this As TLawSubject

Public Property Get Name() As RefPair
    Set Name = this.Name
End Property

Public Property Get Id() As RefPair
    Set Id = this.Id
End Property

Public Property Get Address() As RefPair
    Set Address = this.Address
End Property

Использование:

Параметр Явный

Sub Testing()

    Dim LwSbjct As LawSubject

    Set LwSbjct = New LawSubject

        LwSbjct.Address.Tag = "Address Tag"
        LwSbjct.Address.Value = "Address Value"

        LwSbjct.Name.Tag = "Name Tag"
        LwSbjct.Name.Value = "Name Value"

        LwSbjct.Id.Tag = "Id Tag"
        LwSbjct.Id.Value = "Id Value"


        Debug.Print LwSbjct.Address.Tag
        Debug.Print LwSbjct.Address.Value

        Debug.Print LwSbjct.Name.Tag
        Debug.Print LwSbjct.Name.Value

        Debug.Print LwSbjct.Id.Tag
        Debug.Print LwSbjct.Id.Value

End Sub

Результаты непосредственного окна:

Answer 3

Существует также способ использования словаря, возможно, избыточного, но он дает возможность добавлять новые пары данных на лету.

Класс как таковой

Public Extract As Scripting.Dictionary

Private Sub Class_Initialize()

Set Extract = New Scripting.Dictionary

AddDefault "Name", "1"
AddDefault "ID", "2"
AddDefault "Address", "3"

End Sub

Private Sub Class_Terminate()
    Set Extract = Nothing
End Sub

Public Function AddToExisting(strKey As String, _
                            strContentsKey As String, _
                            strContentsValue As String)

        Extract(strKey).Add strContentsKey, strContentsValue

End Function

Private Function AddDefault(strKey As String, strValue As String)
    Extract.Add strKey, CreateKeyValuePair(strKey & " Tag", strValue)
End Function

Private Function CreateKeyValuePair( _
                                        strKey As String, _
                                        strValue As String) As Scripting.Dictionary

Dim dicTemp As New Scripting.Dictionary

With dicTemp
    .Add "Tag", strKey
    .Add "Value", strValue
End With

Set CreateKeyValuePair = dicTemp

End Function

Затем используется кактак

Sub testComplex()

Dim c As New clsComplex

Debug.Print c.Extract("Name")("Tag")
Debug.Print c.Extract("Name")("Value")

c.AddToExisting "ID", "Date of Value", CStr(Date)
c.AddToExisting "ID", "Date of Value Check", CStr(Date + 20)

Debug.Print c.Extract("ID")("Tag")
Debug.Print c.Extract("ID")("Value")
Debug.Print c.Extract("ID")("Date of Value")
Debug.Print c.Extract("ID")("Date of Value Check")

c.AddToExisting "Address", "Address Proof", "Utility Bill"
Debug.Print c.Extract("Address")("Tag")
Debug.Print c.Extract("Address")("Value")
Debug.Print c.Extract("Address")("Address Proof")

Set c = Nothing

End Sub