2008-10-20 9 views
7

¿Existe una manera genérica de clonar objetos en VBA? ¿Para que pueda copiar xay en vez de copiar solo el puntero?¿Clonación de objetos en VBA?

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 

Por genérica quiero decir algo así como Set y = CloneObject(x) en lugar de tener que crear mi propio método para copiar sus propiedades de clase uno por uno.

Respuesta

6

OK, aquí está el comienzo de algo que lo ilustra:

Crear una clase, lo llaman, oh, "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 

Ahora tenemos que darle una función de clonación. En otro módulo, intente esto:

Option Explicit

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 

Run eso, y se agrega lo siguiente en Class1

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

... que se parece a un comienzo. Muchas cosas que limpiaría (y probablemente lo haga, esto resultó ser divertido). Una buena expresión regular para encontrar los atributos gettable/lettable/settable, refactorizar en varias funciones pequeñas, codificar para eliminar funciones viejas de "Clone" (y poner la nueva al final), algo un poco más Stringbuilder-ish to DRY (Don ' t Repeat Yourself) hasta las concatenaciones, cosas así.

+0

Gran idea Mike, aunque sospecho que mantener el método Clone manualmente podría ser más fácil en mi caso. Muy buena idea sin embargo. –

1

No creo que haya nada incorporado, aunque sería agradable.

Creo que al menos debería haber una manera de crear un método Clone automáticamente usando el Editor de VBA. Voy a ver si puedo echar un vistazo a él una vez que tengo los niños a la cama ...

1
Private pOldinfo As YourClass 

Public Property Set clone(ByVal Value As YourClass) 
    Set pOldinfo = Value 
End Property 

la palabra clave ByVal debería resolver su problema.