Excel VBA: Вставка графических объектов

[dashamath]

Помогите разобраться,пожалуйста. Как вставить несколько одинаковых графических объектов? Допустим на прямоугольник из диапазона А1:G14 нужно вставить 20 звезд. Как это сделать? с одной звездой проблем нет, а как несколько не пойму. Заранее спасибо!

Private Sub CommandButton1_Click()
With Worksheets("Лист3")
   .With Range("A1:G1", "A14:G14").Interior
       .ColorIndex = 25
       .Pattern = xlSolid
       ActiveSheet.Shapes.AddShape(msoShape5pointStar, 54, 47.75, 11.25, 12#).Select
       Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1
End With
End Sub

[Администратор]

Цитата:
на прямоугольник из диапазона А1:G14

Что вы подразумеваете под прямоугольником? Лучше приложите файл с этим прямоугольником, чтобы было понятно, о чём вы пишите.

[dashamath]

Необходимо нарисовать флаг США.

[вложение удалено администратором]

[Администратор]

Вам останется только скорректировать лево и верх звёзд, чтобы они были так, как вам нужно.

Макрос

Private Sub CommandButton1_Click()

    Dim shp As Shape
    Dim lngLeft As Long, lngTop As Long, i As Long
   
    '1. Отключение монитора для ускорения макроса.
    Application.ScreenUpdating = False
   
    '2. Оформление фрагмента "A1:G14".
    With Worksheets("Лист3").Range("A1:G1", "A14:G14").Interior
        .ColorIndex = 25
        .Pattern = xlSolid
    End With
   
    '3. Лево и верх для первой звезды.
    lngLeft = 10
    lngTop = 5
   
    '4. Вставка звёзд.
    For i = 1 To 20 Step 1
        '1) Вставка звёзды и присваивание звезде имени "shp". Далее к этой звезде
            ' можно обращаться по имени "shp".
        Set shp = ActiveSheet.Shapes.AddShape(msoShape5pointStar, 54, 47.75, 11.25, 12#)
        '2) Перемещение звёзды в нужную позицию.
        shp.Left = lngLeft
        shp.Top = lngTop
        ' Расчёт лева и верха для следующей звезды.
        lngLeft = lngLeft + 25
        ' Если звёзды заняли весь ряд, то нужно переходить вниз.
        If lngLeft > 315 Then
            lngLeft = 10
            lngTop = lngTop + 20
        End If
        '3) Оформление звезды.
        shp.Fill.ForeColor.SchemeColor = 1
    Next i
   
    '5. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub

[свернуть]

[dashamath]

Огромное спасибо!!!