Как скопировать элемент управления ActiveX на другой лист, предотвращая изменение имени элемента управления

Question

Я использую приведенный ниже код, чтобы скопировать командную кнопку с одного листа и вставить ее на другой:

Sheets("SRC").HasACustomName.Copy
Sheets("TRGT").Range("O1").PasteSpecial

Когда я вставляю его, он переименовывается из HasACustomName в CommandButton1,

Могу ли я скопировать / вставить его таким образом, чтобы сохранить имя, или изменить имя после вставки?

Answer 1

ActiveX

Вы можете скопировать элемент управления ActiveX с одного листа на другой с помощью приведенного ниже кода.

Примечание: вы не можете иметь два объекта с одним и тем же именем в одной электронной таблице.

Sub CopyActiveX()
    Application.ScreenUpdating = False
    Dim x As OLEObject, y As OLEObject
    Set x = Sheets("SRC").OLEObjects("HasCustomName")
    Set y = x.Duplicate
    Dim xName As String
    xName = x.Name
    y.Cut
    With Sheets("TRGT")
        .Paste
        .OLEObjects(.OLEObjects.Count).Name = xName
        .Activate
    End With
    Application.ScreenUpdating = True
End Sub

---

Контроль формы

Чтобы скопировать кнопку с одного листа на другой, предотвращающую автоматическое изменение имени, используйте приведенный ниже код. Excel по умолчанию присваивает копируемой кнопке новое имя (даже на другом листе), поэтому вам нужно переименовать ее, чтобы она соответствовала названию копируемой кнопки.

использование CopyButton() саб для достижения этого. Есть 4 обязательных параметра

• from - название листа для копирования кнопки с
• btnName - название элемента управления, который вы хотите скопировать
• toWorksheet - целевой лист
• rng - целевой диапазон, чтобы связать с кнопкой

---

Sub CopyPasteButton()
    CopyButton "SRC", "Button 1", "TRGT", "B10"
End Sub

Private Sub CopyButton(from As String, btnName As String, toWorksheet As String, rng As String)
    Application.ScreenUpdating = False
    Sheets(from).Shapes(btnName).Copy
    Sheets(toWorksheet).Activate
    Sheets(toWorksheet).range(rng).Select
    Sheets(toWorksheet).Paste
    Selection.ShapeRange.Name = btnName
    Application.ScreenUpdating = True
End Sub