Переместить группу объектов (кнопок) на каждом листе

Question

Я вставил три кнопки на каждом листе в свою электронную таблицу Excel и сгруппировал их вместе с этим VBA:

Sub Create_New_Buttons()
Dim b As Worksheet
For Each b In Worksheets

        b.Select
        Dim Button_01 As Button
        Set Button_01 = b.Buttons.Add(423.75, 0, 48, 15)
        Dim Range_Button_01 As Range
        Set Range_Button_01 = b.Range("B2:B4")
        Button_01.Name = "Button_01"
        With Button_01
        .Top = Range_Button_01.Top
        .Left = Range_Button_01.Left
        .Width = Range_Button_01.Width
        .Height = Range_Button_01.Height
        End With

        b.Select
        Dim Button_02 As Button
        Set Button_02 = b.Buttons.Add(423.75, 0, 48, 15)
        Dim Range_Button_02 As Range
        Set Range_Button_02 = b.Range("D2:D4")
        Button_02.Name = "Button_02"
        With Button_02
        .Top = Range_Button_02.Top
        .Left = Range_Button_02.Left
         .Width = Range_Button_02.Width
        .Height = Range_Button_02.Height
        End With

        Rem Combine buttons to group
        Set ButtonList = b.Shapes.Range(Array("Button_01", "Button_02")).Group
        ButtonList.Name = "Button_Group"

Next b

End Sub

Все это прекрасно работает.

---

Теперь я хочу создать VBA, чтобы переместить эту группу кнопок на каждом листе в Range("F15:F16").
Поэтому я попытался go со следующим VBA:

Sub Move_Group_of_Buttons()
Dim b As Worksheet
For Each b In Worksheets
        Dim rng As Range
        Set rng = b.Range("F15:F16")
        b.Select
        With Button_Group
        .Top = rng.Top
        .Left = rng.Left
        .Width = rng.Width
        .Height = rng.Height
        End With
Next b
End Sub

Однако, когда я запускаю этот VBA, я получаю runtime error 424 в строке .Top = Range.Top.
Что мне нужно изменить в моем коде, чтобы он работал?

Answer 1

3 сценария ios. Выберите.

---

Если вы не уверены, что кнопки существуют, а также не уверены, сгруппированы они или нет, попробуйте это.

Logi c

Если кнопки уже добавлены в рабочие таблицы, используйте эту логику c

1. Проверьте, существуют ли «Button_01», «Button_02»
2. Проверьте, являются ли они частью группы
3. Если нет, сгруппируйте и переместите
4. Если они таковы, получите имя сгруппированной фигуры и переместите

Код

Option Explicit

Sub Move_Group_of_Buttons()
    Dim rng As Range, ws As Worksheet
    Dim shpA As Shape, shpB As Shape, shp As Shape, ButtonList As Shape
    Dim PartOfGroup As Boolean
    Dim GrpName As String
    Dim i As Long

    '~~> Loop through the worksheets
    For Each ws In ThisWorkbook.Worksheets
        With ws
            '~~> set your range
            Set rng = .Range("F15:F16")

            '~~> Check if buttons with that name exists
            On Error Resume Next
            Set shpA = .Shapes("Button_01")
            Set shpB = .Shapes("Button_02")
            On Error GoTo 0

            If shpA Is Nothing Or shpB Is Nothing Then
                Debug.Print "Shapes not found in sheet " & ws.Name
            Else
                PartOfGroup = False
                GrpName = ""

                '~~> Check if the buttons are part of a group
                For Each shp In .Shapes
                    If shp.Type = msoGroup Then
                        For i = 1 To shp.GroupItems.Count
                            If shp.GroupItems(i).Name = "Button_01" Or _
                               shp.GroupItems(i).Name = "Button_02" Then
                                PartOfGroup = True
                                GrpName = shp.Name
                                Exit For
                            End If
                        Next i
                    End If
                Next shp

                '~~> If part of group
                If PartOfGroup = True Then
                    With .Shapes(GrpName)
                        .Top = rng.Top
                        .Left = rng.Left
                        .Width = rng.Width
                        .Height = rng.Height
                    End With
                Else '<~~ If Not
                    Set ButtonList = .Shapes.Range(Array("Button_01", "Button_02")).Group

                    With ButtonList
                        .Top = rng.Top
                        .Left = rng.Left
                        .Width = rng.Width
                        .Height = rng.Height
                    End With
                End If
            End If
        End With
    Next ws
End Sub

---

Если кнопки существуют и уже сгруппированы и имеют имя Button_Group, попробуйте это

Option Explicit

Sub Move_Group_of_Buttons()
    Dim rng As Range, ws As Worksheet
    Dim ButtonList As Shape

    '~~> Loop through the worksheets
    For Each ws In ThisWorkbook.Worksheets
        With ws
            '~~> set your range
            Set rng = .Range("F15:F16")

            Set ButtonList = .Shapes("Button_Group")

            With ButtonList
                .Top = rng.Top
                .Left = rng.Left
                .Width = rng.Width
                .Height = rng.Height
            End With
        End With
    Next ws
End Sub

---

Если кнопки существуют и не сгруппированы , попробуйте это

Option Explicit

Sub Move_Group_of_Buttons()
    Dim rng As Range, ws As Worksheet
    Dim ButtonList As Shape

    '~~> Loop through the worksheets
    For Each ws In ThisWorkbook.Worksheets
        With ws
            '~~> set your range
            Set rng = .Range("F15:F16")

            Set ButtonList = .Shapes.Range(Array("Button_01", "Button_02")).Group

            With ButtonList
                .Top = rng.Top
                .Left = rng.Left
                .Width = rng.Width
                .Height = rng.Height
            End With
        End With
    Next ws
End Sub