CODEWITHSUNDEEP
excelvba
PP8
PP8

Reputation: 197

How to align shapes using VBA Loop

My code loops a range of cells, which in return adds a shape with the cells value if the cell value within the range is greater than 1.

I would like each newly added shape to be evenly positioned to the right of the first added shape.

Currently my code stacks every shape on top of each other.

Code

Sub foo()
Dim oval As Shape
Dim rCell As Range
Dim rng As Range
Dim h As Integer
Dim w As Integer
Dim x As Long
Dim shp As Object

h = h + 50 + 2
w = w + 200 + 2
Set rng = Sheet1.Range("A1:A7")



For Each rCell In rng

If rCell > 0 Then

    Set oval = ActiveSheet.Shapes.AddShape(msoShapeOval, h + 1, w + 1, 75, 80)

With oval
    .Line.Visible = True
    .Line.Weight = 8
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .Line.ForeColor.RGB = RGB(0, 0, 0)
    .TextFrame.Characters.Caption = rCell.Value
    .TextFrame.HorizontalAlignment = xlHAlignCenter
    .TextFrame.VerticalAlignment = xlVAlignCenter
    .TextFrame.Characters.Font.Size = 22
    .TextFrame.Characters.Font.Bold = True
    .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
End With

End If

    Next rCell

End Sub

Screenshot enter image description here

Upvotes: 0

Views: 1010

Answers (1)

BigBen
BigBen

Reputation: 50008

Some math should do the trick. The 95 is the width of 75 plus a margin of 20. Adjust as needed.

For Each rCell In rng
    If IsNumeric(rCell.Value) Then
        If rCell.Value > 0 Then
            Dim counter As Long
            counter = counter + 1

            Set oval = ActiveSheet.Shapes.AddShape(msoShapeOval, h + 95 * (counter - 1), w + 1, 75, 80)

            With oval
                .Line.Visible = True
                .Line.Weight = 8
                .Fill.ForeColor.RGB = RGB(255, 255, 255)
                .Line.ForeColor.RGB = RGB(0, 0, 0)
                .TextFrame.Characters.Caption = rCell.Value
                .TextFrame.HorizontalAlignment = xlHAlignCenter
                .TextFrame.VerticalAlignment = xlVAlignCenter
                .TextFrame.Characters.Font.Size = 22
                .TextFrame.Characters.Font.Bold = True
                .TextFrame.Characters.Font.Color = RGB(0, 0, 0)
            End With
        End If
    End If
Next rCell

Note that Shapes.AddShape has the arguments Type, Left, Top, Width, Height, so using h and w for Left and Top is a little confusing.

Upvotes: 5

Related Questions