Option
Explicit
Sub
Bsp()
Dim
shp
As
Excel.Shape
Dim
s
As
Double
Dim
p
As
Double
With
Range(
"B3"
)
.RowHeight = 14
.ColumnWidth = 60
.Interior.Color = rgbOrange
s = 0.75
For
p = 0
To
1
Step
0.25
If
.Width >= .Height
Then
Set
shp = .Worksheet.Shapes.AddShape(msoShapeOval, _
Left:=.Left + p * (.Width - s * .Height), _
Top:=.Top + 0.5 * (1 - s) * .Height, _
Width:=s * .Height, _
Height:=s * .Height)
Else
Set
shp = .Worksheet.Shapes.AddShape(msoShapeOval, _
Left:=.Left + 0.5 * (1 - s) * .Width, _
Top:=.Top + p * (.Height - s * .Width), _
Width:=s * .Width, _
Height:=s * .Width)
End
If
Next
End
With
End
Sub