在VBA中克隆对象?

时间:2008-10-20 14:47:31

标签: vba clone

是否有通用的方法来克隆VBA中的对象?这样我可以将x复制到y而不是只复制指针吗?

  Dim x As New Class1
  Dim y As Class1

  x.Color = 1
  x.Height = 1

  Set y = x
  y.Color = 2

  Debug.Print "x.Color=" & x.Color & ", x.Height=" & x.Height

通用我的意思是Set y = CloneObject(x),而不是必须为类逐个复制其属性创建自己的方法。

3 个答案:

答案 0 :(得分:7)

好的,这是说明它的事情的开始:

创建一个类,调用它,哦,“Class1”:

Option Explicit

Public prop1 As Long
Private DontCloneThis As Variant

Public Property Get PrivateThing()
    PrivateThing = DontCloneThis
End Property

Public Property Let PrivateThing(value)
    DontCloneThis = value
End Property

现在我们需要给它一个克隆功能。在另一个模块中,试试这个:

选项明确

Public Sub makeCloneable()

Dim idx As Long
Dim line As String
Dim words As Variant
Dim cloneproc As String

' start building the text of our new function
    cloneproc = "Public Function Clone() As Class1" & vbCrLf
    cloneproc = cloneproc & "Set Clone = New Class1" & vbCrLf

    ' get the code for the class and start examining it    
    With ThisWorkbook.VBProject.VBComponents("Class1").CodeModule

        For idx = 1 To .CountOfLines

            line = Trim(.lines(idx, 1)) ' get the next line
            If Len(line) > 0 Then
                line = Replace(line, "(", " ") ' to make words clearly delimited by spaces
                words = Split(line, " ") ' so we get split on a space
                If words(0) = "Public" Then ' can't set things declared Private
                    ' several combinations of words possible
                    If words(1) = "Property" And words(2) = "Get" Then
                        cloneproc = cloneproc & "Clone." & words(3) & "=" & words(3) & vbCrLf
                    ElseIf words(1) = "Property" And words(2) = "Set" Then
                        cloneproc = cloneproc & "Set Clone." & words(3) & "=" & words(3) & vbCrLf
                    ElseIf words(1) <> "Sub" And words(1) <> "Function" And words(1) <> "Property" Then
                        cloneproc = cloneproc & "Clone." & words(1) & "=" & words(1) & vbCrLf
                    End If
                End If
            End If
        Next

        cloneproc = cloneproc & "End Function"

        ' put the code into the class
        .AddFromString cloneproc

    End With

End Sub

运行它,并将以下内容添加到Class1

Public Function Clone() As Class1
Set Clone = New Class1
Clone.prop1 = prop1
Clone.PrivateThing = PrivateThing
End Function

...看起来像个开始。很多东西我要清理(可能会 - 这结果很有趣)。一个很好的正则表达式,用于查找gettable / lettable / settable属性,重构为几个小函数,代码删除旧的“克隆”函数(并将新的函数放在最后),更多的东西是Stringbuilder-ish to DRY(Don' t重复自己)连接,这样的东西。

答案 1 :(得分:5)

Scott Whitlock在另一个问题上发布了fantastic answer这个问题。

答案 2 :(得分:1)

我认为没有内置任何东西,虽然它会很好。

我认为至少应该有一种方法可以使用VBA编辑器自动创建Clone方法。一旦我让孩子们睡觉,我会看看能不能看看它......