好的,这是说明它的开始:
创建一个类,叫它,哦,“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 重复你自己)向上串联,诸如此类。