无法进行复杂的课程

时间:2019-10-13 12:09:14

标签: vba ms-word

我正在尝试制作具有以下结构的复杂类:

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"字符串上遇到错误:compile error: invalid outside procedure我怎么了?

3 个答案:

答案 0 :(得分:4)

您正在尝试设置对象的属性,该属性只能在过程内部在VBA中使用。 (子,函数或属性)

或者,您可以将属性let语句移至optimization过程:

Class_Initialize

但是我是否建议您不应该使用用于存储2个字符串值的类模块?开销是巨大的。 相反,请考虑使用Type:

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

这样,您可以封装类的相关数据,同时通过提供属性访问器来更好地控制从外部操作内部值的过程。例如:

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

答案 1 :(得分:0)

还有一种使用字典的方法,也许是矫over过正,但可以即时添加新的数据对。

像这样的班

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

答案 2 :(得分:0)

您需要的是父对象LawSubject,以保存对子对象RefPair的引用。最接近您的示例(我认为是C++吗?)的实现如下:

类别: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

类别: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

立即窗口结果:

enter image description here