pramodpandit
04-18-2020, 09:12 AM
I need shapes to be copied and increased just like in picture.I tried Using Addshapes but it is not the right way to do it i think.How can i just copy and insert shapes with increase in its series.I tried copy and pasting range but the shapes did not copy.Following is a code i did using Addshapes.Also can anyone tell how to exactly find the Left,top value from {AddShape(msoShapeOval, iLeft, iTop, iWidth, iheight)} or its just Hit and trial ?
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
26368
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
26368