Скопируйте объект без ссылки в VBA

Question

У меня проблема с переменными объекта в VBA.Можно ли просто скопировать переменные объекта без какой-либо ссылки?

Здесь модуль класса "clstest"

Option Explicit

Public x As Single

А вот мой Sub:

Sub CopyWithoutReference()

Dim standard As New clstest
Set standard = New clstest

Dim different As New clstest

standard.x = 20

Set different = standard
different.x = 30

MsgBox "I want standard.x to be 20 and not 30"
MsgBox standard.x
MsgBox different.x

Iхотите, чтобы standard.x сохранил свое значение и не изменился, если другой .x изменится.Я читал эту статью здесь: https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/set-statement И там говорится:

"Поскольку такие переменные являются ссылками на объект, а не копиями объекта, любое изменение в объекте отражается во всех переменных, которые ссылаютсяк нему. "

Но я не знаю, как устранить эту проблему.Кто-нибудь из вас знает, как мне помочь?

Answer 1

Этот ответ о VB6 довольно хорош , реализация шаблона сувенира и способ ссылки на свойства через тип в VBA - это то, что позволяет копировать свойства.

---

Создан объект типа Employee со свойствами Salary, Age и RelevantExperience.Затем создается новый объект, копирующий старый с помощью функции .Copy.Новый объект изначально имеет те же свойства, но мы можем изменить некоторые из них.В приведенном ниже коде Опыт и Возраст изменен, Зарплата не упоминается, поэтому он остается тем же:

Dim newEmp As Employee
Dim oldEmp As Employee

Set newEmp = New Employee
With newEmp
    .Salary = 100
    .Age = 22
    .RelevantExperience = 1
End With

Set oldEmp = newEmp.Copy
With oldEmp
    'Salary is the same as in the NewEmp
    .Age = 99
    .RelevantExperience = 10
End With

Это результат:

Старый Сотрудник получает такую ​​же зарплату, "унаследованную" новым сотрудником, когда он копируется.Опыт и Возраст различны.

Полная реализация

В модуле:

Type MyMemento
    Salary As Double
    Age As Long
    RelevantExperience As Long
End Type

Sub Main()

    Dim newEmp As Employee
    Dim oldEmp As Employee

    Set newEmp = New Employee
    With newEmp
        .Salary = 100
        .Age = 22
        .RelevantExperience = 1
    End With

    Set oldEmp = newEmp.Copy
    With oldEmp
        'Salary is inherited, thus the same
        .Age = 99
        .RelevantExperience = 10
    End With

    Debug.Print "Salary"; vbCrLf; newEmp.Salary, oldEmp.Salary
    Debug.Print "Experience"; vbCrLf; newEmp.RelevantExperience, oldEmp.RelevantExperience
    Debug.Print "Age"; vbTab; vbCrLf; newEmp.Age, oldEmp.Age

End Sub

В модуле класса, называемом Employee:

Private Memento As MyMemento

Friend Sub SetMemento(NewMemento As MyMemento)
    Memento = NewMemento
End Sub

Public Function Copy() As Employee
    Dim Result As Employee
    Set Result = New Employee        
    Result.SetMemento Memento
    Set Copy = Result        
End Function

Public Property Get Salary() As Double
    Salary = Memento.Salary
End Property    
Public Property Let Salary(value As Double)
    Memento.Salary = value
End Property

Public Property Get Age() As Long
    Age = Memento.Age
End Property    
Public Property Let Age(value As Long)
    Memento.Age = value
End Property

Public Property Get RelevantExperience() As Long
    RelevantExperience = Memento.RelevantExperience
End Property    
Public Property Let RelevantExperience(value As Long)
    Memento.RelevantExperience = value
End Property

Answer 2

Вы можете добавить метод clone в класс, поэтому у меня есть

Мой класс

Public x As Integer

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

Мой модуль

Sub a()

Dim o As Class1
Dim o2 As Class1

Set o = New Class1
o.x = 20

Set o2 = o.Clone
o2.x = 500

Debug.Print o.x, o2.x

End Sub

------------------- COPY ALLL ОДНАЖДА ИДЕЯ ---------------------

Новый класс

Public Properties_ As Scripting.Dictionary

Private Sub Class_Initialize()
    Set Properties_ = New Scripting.Dictionary
End Sub

Public Sub Set_Property(strPropertyName As String, varProperty As Variant)
    If Properties_.Exists(strPropertyName) Then
        Properties_(strPropertyName) = varProperty
    Else
        Properties_.Add strPropertyName, varProperty
    End If
End Sub

Public Function Clone_() As Class1

    Set Clone_ = New Class1

    For i = 0 To Properties_.Count - 1
        Clone_.Set_Property CStr(Properties_.Keys()(i)), Properties_.Items()(i)

    Next i

End Function

Новый модуль

Public Sub x()

Dim o1 As Class1
Dim o2 As Class1

Set o1 = New Class1

o1.Set_Property "Date", Now
o1.Set_Property "Name", "Test Name"

Set o2 = o1.Clone_

o2.Set_Property "Date", DateSerial(2000, 1, 1)

Debug.Print o1.Properties_("Date"), o2.Properties_("Date")

End Sub