VBA/Excel/Access/Word/Excel/Shapes

Add a new shape

   <source lang="vb">

Private Sub btnShowAllAutoShapes_Click()

 Dim i&
 On Error Resume Next
 For i = 0 To 136
   ActiveSheet.Shapes.AddShape i + 1, 40 + 50 * (i Mod 12), 50 + 50 * (i \ 12), 40, 40
 Next

End Sub

</source>
   
  

Add a rectangle

   <source lang="vb">

Sub AddRectangle()

   With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 200, 100).TextFrame
       .Characters.Text = "This is a rectangle"
       .HorizontalAlignment = xlHAlignCenter
       .VerticalAlignment = xlVAlignCenter
   End With

End Sub

</source>
   
  

Delete all shapes

   <source lang="vb">

Private Sub btnDeleteShapes_Click()

 Dim s As Shape
 For Each s In ActiveSheet.Shapes
   If s.Type = msoAutoShape Or s.Type = msoLine Then s.Delete
 Next

End Sub

</source>
   
  

Display auto shapes

   <source lang="vb">

Sub DisplayAutoShapes()

   Dim sh As Shape
   Dim i As Integer
   Set sh = ActiveSheet.Shapes.AddShape(1, 100, 100, 72, 72)
   For i = 1 To 138
      sh.AutoShapeType = i
      sh.Visible = True
      ActiveSheet.Cells(1, 1).Value = sh.AutoShapeType
      Delay 0.5
   Next i

End Sub

</source>
   
  

Draw a star

   <source lang="vb">

Private Sub btnStar_Click()

 Dim degree#
 Dim s As Shape
 Const Pi = 3.1415927
 Randomize
 For degree = 0 To 2 * Pi Step Pi / 12
   Set s = ActiveSheet.Shapes.AddLine(200, 200, 200 + 100 * Sin(degree), 200 + 100 * Cos(degree))
   s.Line.EndArrowheadStyle = msoArrowheadTriangle
   s.Line.EndArrowheadLength = msoArrowheadLengthMedium
   s.Line.EndArrowheadWidth = msoArrowheadWidthMedium
   s.Line.ForeColor.RGB = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
 Next

End Sub

</source>