Как скопировать элемент управления 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