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

Question

Я пытался сделать это с помощью .Addshape, но я чувствую, что это не лучший способ сделать это. Я чувствую, что копирование и вставка с увеличением числа серий - лучший способ сделать это, но я не смог найти способ сделать это, поскольку я начинающий в VBA

.

Private Sub Click()

    Dim i, iLeft, iTop, iWidth, iheight As Integer
    Dim c, j As Range

    Set j = Range("A4")
    Set c = Range("D7:D8")

    iLeft = c.Left + (c.Width / 4)
    iTop = c.Top
    iWidth = c.Width / 2
    iheight = c.Height

    For i = 1 To j

        Dim ovalShape As Shape
        Set ovalShape = Sheet1.Shapes.AddShape(msoShapeOval, iLeft, iTop, iWidth, iheight)

        With ovalShape
            ovalShape.ShapeStyle = msoLineStylePreset7
            ovalShape.TextFrame.Characters.Text = i
        End With

        iLeft = iLeft + 145
        DoEvents
    Next

End Sub

Answer 1

Ваша единственная проблема - изменить:

For i = 1 To j

на:

For i = 1 To j.Value

, поскольку j затемнено и установлено как Range объект

Но так как вы используете этот диапазон только для извлечения его значения в начале, то лучше всего:

dim j As Long
…. 
j = Range("A4").Value

Кроме этого, вы можете использовать явные переменные затемнения вместе с оператором Option Explicit:

Option Explicit

Private Sub Click()

    Dim i As Long, iLeft As Long, iTop As Long, iWidth As Long, iHeight As Long, j As Long
    Dim c As Range

    j = Range("A4").Value
    Set c = Range("D7:D8")

    iLeft = c.Left + (c.Width / 4)
    iTop = c.Top
    iWidth = c.Width / 2
    iHeight = c.Height

    With Sheet1 ' reference 'Sheet1' worksheet
        For i = 1 To j

            With .Shapes.AddShape(msoShapeOval, iLeft, iTop, iWidth, iHeight) ' reference referenced sheet newly added shape
                .ShapeStyle = msoLineStylePreset7
                .TextFrame.Characters.Text = i
            End With
            DoEvents
            With c.Offset(, 3 * i)
                iWidth = .Width / 2
                iLeft = .Left + .Width / 4
            End With
        Next
    End With

End Sub

Как видите, я:

1) изменил все типы Integer на Long

, потому что в VBA Integer s колеблется до +/- 32k, а Long s достигают +/- 2 миллиардов, и рекомендуется использовать этот последний тип, чтобы не вызывать ошибки переполнения, например, при циклическом перемещении строк, которые могут достигать 1 миллиона или около того

2) явно объявлены все переменные

, поскольку в VBA все неявно объявленные переменные принимаются как Variant тип

, так что

Dim i, iLeft, iTop, iWidth, iheight As Integer
Dim c, j As Range

будет читаться как:

Dim i As Variant, iLeft As Variant, iTop As Variant, iWidth As Variant, iheight As Integer
Dim c As Variant, j As Range

пока вы хотите их как:

Dim i As Long, iLeft As Long, iTop As Long, iWidth As Long, iheight As Long
Dim c As Range, j As Range