Необходимо проверить существующую кнопку и добавить новую кнопку ниже (не кнопку команды)

Question

У меня есть следующий код, в котором пользователь вводит имя маршрута доставки, а затем создается рабочий лист и кнопка для маршрута. Затем они могут щелкнуть по кнопке, и она переведет их на соответствующий рабочий лист маршрута, где они смогут вводить номера счетов. Мне нужно настроить это, чтобы добавить дополнительные маршруты. Прямо сейчас существующая кнопка переопределяется новой кнопкой. Мне нужна новая кнопка для нового маршрута, добавленного ниже существующей кнопки. Хуже того, это нужно использовать на нескольких сайтах с различным количеством маршрутов. Итак, мне нужен лист, чтобы пользователь мог добавлять дополнительные маршруты (что приведет к добавлению дополнительных кнопок), и если они доберутся до 8 кнопок в одном столбце, я хочу, чтобы он запустил другой столбец справа от первый столбец кнопок. Я изо всех сил пытаюсь найти хороший способ сделать это. Я был бы очень признателен за любые рекомендации. Спасибо. Вот код, я использую до сих пор:

Sub AddRoute() 
    Dim btn As Button 
    Application.ScreenUpdating = False 
    Dim t As Range 
    Dim sName As String 
    Dim wks As Worksheet 
    Worksheets("NewRoute").Copy after:=Sheets(Worksheets.Count) 
    Set wks = ActiveSheet 
    Do While sName <> wks.Name 
     sName = Application.InputBox _ 
      (Prompt:="Enter new route name") 
     On Error Resume Next 
     wks.Name = sName 
     Worksheets("Home").Activate 
     On Error GoTo 0 

     Set t = ActiveSheet.Range(Cells(2, 12), Cells(3, 13)) 
     Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height) 


    With btn 
     .OnAction = "'btnS""" & sName & """'" 
     .Caption = sName 
     .Name = sName 
    End With 

    Application.ScreenUpdating = True 
    Loop 
    Set wks = Nothing 

End Sub 



Sub btnS(sName) 
    Worksheets(sName).Activate 
    Range("A:A").Find("").Select 

End Sub

Answer 1

Проблема в том, что вы ссылку же диапазон «T» все разы вы запускаете макрос. Вы должны объявить две переменные int и инициализировать ее с помощью 2 и 3 и добавить 2 для этих двух переменных int в конце цикла.

Например:

Dim i As Integer 
Dim j As Integer 

i = 2 
j = 3 

Do While sName <> wks.Name 

    sName = Application.InputBox _ 
     (Prompt:="Enter new route name") 
    On Error Resume Next 
    wks.Name = sName 
    Worksheets("Home").Activate 
    On Error GoTo 0 

    Set t = ActiveSheet.Range(Cells(i, 12), Cells(j, 13)) 
    Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height) 


    With btn 
     .OnAction = "'btnS""" & sName & """'" 
     .Caption = sName 
     .Name = sName 
    End With 

    i = i + 2 
    j = j + 2 

    Application.ScreenUpdating = True 
Loop