Предоставление уникальных случайных имен для скопированных фигур

Question

Я пытаюсь скопировать и вставить форму от sheet2 до sheet1 в VBA. Однако, после вставки несколько раз. Я замечаю, что формы имеют одно и то же имя, что означает, что они используют один и тот же макрос, и макрос применяется только к первой форме, вставленной с тем же именем. Чтобы решить эту проблему, я использовал следующий код для случайного восстановления имени формы в листе 1 после копирования.

Public Function RL() 
    Dim Rand As String 
    Dim i As Integer, XSet As Integer 
    Dim MyCase As Integer 
    Application.Volatile 
    MyCase = 38: XSet = 85 
    Do 
     i = i + 1 
     Randomize 
     Rand = Rand & Chr(Int((XSet) * Rnd + MyCase)) 
    Loop Until i = 5 
    RL = "X" & Rand 
End Function 

Однако, я обнаружил, что все еще может быть случаи, когда случайное имя RL не являются уникальными в sheet1, Хотя это довольно редко, это случилось довольно много раз. Таким образом, я решил добавить в функцию функцию RL(), чтобы узнать, существуют ли сгенерированные RL в sheet1. Тем не менее, я нашел это довольно много времени, поскольку в sheet1 существует множество форм. Есть ли эффективный способ, чтобы я мог копировать и вставлять уникально?

Answer 1

Проблема заключается не в том, что вставные фигуры имеют одинаковое имя, потому что имена увеличиваются на 1 для каждой новой пасты. Вы можете проверить это, нажав Найти & Выберите> Панель выбора в разделе «Редактирование» на вкладке «Главная» на ленте.

При копировании и вставке фигуры с присвоенным ей макросом выполняется также копирование макроса.

Если вы хотите последующие копии/пасты, не имеют назначение макроса тогда

Worksheets(1).Shapes(2).OnAction = "" 

сбросит назначение макроса.

Как вы стреляете, чтобы петли через ваши фигуры, это еще один вопрос. Не существует события, которое я знаю о том, что оно срабатывает, когда форма вставляется в лист.

Answer 2

Тем не менее, я обнаружил, что все еще могут быть случаи, когда случайное имя RL не уникально в sheet1, хотя это довольно редко, это произошло довольно много раз.

Это то, что я использую для получения случайных имен. Очень прямо и просто. Нет. Два имени будут одинаковыми, если вы не будете играть с системными часами.

Option Explicit 

Sub Sample() 
    Dim i As Long 

    For i = 1 To 10 
     Debug.Print GetNewShpName 
    Next i 
End Sub 

Function GetNewShpName() As String 
    GetNewShpName = "Shp" & Format(Now, "ddmmyyyyhhmmss") 
    Wait 1 
End Function 

Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub 

Пример Имена

Shp18112013120449 
Shp18112013120450 
Shp18112013120451 
Shp18112013120452 
Shp18112013120453 
Shp18112013120454 
Shp18112013120455 
Shp18112013120456 
Shp18112013120457 
Shp18112013120458 

РЕДАКТИРОВАТЬ

Вот это более быстрый способ по сравнению с выше

Option Explicit 

Private Declare Function GetTickCount Lib "kernel32"() As Long 

Sub Sample() 
    Dim i As Long 
    For i = 1 To 10 
     TickTock 
     Debug.Print GetNewShpName 
    Next i 
End Sub 

Function GetNewShpName() As String 
    GetNewShpName = "Shp" & Format(Now, "ddmmyyyyhhmmss") & GetTickCount() 
End Function 

Public Sub TickTock() 
    Dim j As Long, r As Double 
    For j = 0 To 1000000 
     r = Rnd 
    Next 
End Sub 

ВЫХОД

Shp18112013133835168714332 
Shp18112013133835168714363 
Shp18112013133836168714426 
Shp18112013133836168714457 
Shp18112013133836168714504 
Shp18112013133836168714550 
Shp18112013133836168714597 
Shp18112013133836168714644 
Shp18112013133836168714691 
Shp18112013133836168714738 

Answer 3

Решение Siddhart выглядит достаточно прочным, но мне не нравится, что вам нужно подождать секунду для каждой пасты (а также труднодоступные названия). По этому методу именование увеличивается + 1 на основе доступного нет. форм, найденных в целевом листе (в данном случае «PasteSheet»). Ключевыми элементами являются:

• ImcrementValue = Paste_Sheet.Shapes.Count и
• Paste_Sheet.Shapes(ImcrementValue).Name = "Shape" & ImcrementValue

Кодекс:

Sub SetShapeName() 
Dim Copy_Sheet As Worksheet: Set Copy_Sheet = Sheets("Sheet1") 
Dim Paste_Sheet As Worksheet: Set Paste_Sheet = Sheets("Sheet2") 
Dim IncrementValue As Integer 

For i = 1 To Copy_Sheet.Shapes.Count 
    ImcrementValue = Paste_Sheet.Shapes.Count 
    If IncrementValue = 0 Then IncrementValue = 1 'Solves an error if there are no Shapes in the destionation sheet 
    Copy_Sheet.Shapes(i).Copy 
    Paste_Sheet.Paste 
    On Error Resume Next 'Related to same issue as above 
    Paste_Sheet.Shapes(ImcrementValue).Name = "Shape" & ImcrementValue 
Next i 
End Sub 

Сам код копирует все формы из sheet1 на sheet2, но вы должны сосредоточиться на именования, если это не то, что вы ищете. Надеюсь, что это помогает ускорить копирования/вставки и «дефицитные следовать» имена;)

Edit: Этот метод является альтернативой предыдущему, и это не считая формы в пределах целевой лист, но использует инкрементное значение из 3-го листа (который я хотел бы назвать MacroKeys)

Sub SetShapeName_ver2() 
Application.ScreenUpdate = False 
Dim Paste_Sheet As Worksheet: Set Paste_Sheet = Sheets("Sheet2") 
Dim MacroKeys As Worksheet: Set MacroKeys = Sheets("MacroKeys") 
Dim IncrementalValue As Long 

For i = 1 To Paste_Sheet.Shapes.Count 
    ImcrementValue = MacroKeys.Range("A1").Value 
    Paste_Sheet.Shapes(i).Name = "Shape" & ImcrementValue 
    MacroKeys.Range("A1").Value = ImcrementValue + 1 
Next I 
Application.ScreenUpdate = True 
End Sub 

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