2008-10-20 13 views
7

Existe-t-il un moyen générique de cloner des objets dans VBA? Alors que je pourrais copier x à y au lieu de copier seulement le pointeur?Cloner des objets dans 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 

Par je veux dire quelque chose comme Set y = CloneObject(x) générique plutôt que d'avoir à créer ma propre méthode pour la copie de classe ses propriétés un par un.

Répondre

6

OK, voici le début de quelque chose qui l'illustre:

Créer une classe, appelez, 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 

Maintenant, nous devons lui donner une fonction de clonage. Dans un autre module, essayez ceci:

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 qui, et le suivant est ajouté dans Class1

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

... qui ressemble à un début. Beaucoup de choses que je voudrais nettoyer (et probablement - cela s'est avéré être amusant). Une belle expression régulière pour trouver les attributs gable/letting/settable, refactoring en plusieurs petites fonctions, code pour enlever les anciennes fonctions "Clone" (et mettre le nouveau à la fin), quelque chose de plus Stringbuilder-ish to DRY (Don ' Répétez-vous) les concaténations, des trucs comme ça.

+0

Excellente idée Mike, bien que je soupçonne de maintenir manuellement la méthode Clone pourrait être plus facile dans mon cas. Très bonne idée cependant. –

1

Je ne pense pas qu'il y ait quelque chose de intégré, même si ce serait bien.

Je pense qu'il devrait y avoir au moins un moyen de créer une méthode Clone automatiquement en utilisant l'éditeur VBA. Je vais voir si je peux jeter un coup d'oeil une fois que j'ai les enfants au lit ...

1
Private pOldinfo As YourClass 

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

le mot clé ByVal devrait résoudre votre problème.