Creating Shapes

An AutoShape is a Shape object that represents a built-in drawing. To add a new AutoShape object, we use the AddShape method, whose syntax is: 

ShapesObject.AddShape(Type, Left, Top, Width, Height)

The parameter Type is the type of AutoShape to create. It can be any one of the MsoAutoShapeType constants in Table A-1.

The required parameters Left and Top specify the position (in points as a Single) of the upper-left corner of the bounding box for the AutoShape object, measured relative to the upper-left corner of the container object (chart, chart sheet, or worksheet).

The Width and Height parameters specify the width and height (in points as a Single) of the bounding box for the AutoShape. Note that the type of a Shape object can be changed by setting the AutoShapeType property.

Table A-1. MsoAutoShapeType Constants (and Values)

msoShape16pointStar (94)

msoShapeFlowchartCard (75)

msoShapeLineCallout2BorderandAccentBar (122)

msoShape24pointStar (95)

msoShapeFlowchartCollate (79)

msoShapeLineCallout2NoBorder (118)

msoShape32pointStar (96)

msoShapeFlowchartConnector (73)

msoShapeLineCallout3 (111)

msoShape4pointStar (91)

msoShapeFlowchartData (64)

msoShapeLineCallout3AccentBar (115)

msoShape5pointStar (92)

msoShapeFlowchartDecision (63)

msoShapeLineCallout3BorderandAccentBar (123)

msoShape8pointStar (93)

msoShapeFlowchartDelay (84)

msoShapeLineCallout3NoBorder (119)

msoShapeActionButtonBackorPrevious (129)

msoShapeFlowchartDirectAccessStorage (87)

msoShapeLineCallout4 (112)

msoShapeActionButtonBeginning (131)

msoShapeFlowchartDisplay (88)

msoShapeLineCallout4AccentBar (116)

msoShapeActionButtonCustom (125)

msoShapeFlowchartDocument (67)

msoShapeLineCallout4BorderandAccentBar (124)

msoShapeActionButtonDocument (134)

msoShapeFlowchartExtract (81)

msoShapeLineCallout4NoBorder (120)

msoShapeActionButtonEnd (132)

msoShapeFlowchartInternalStorage (66)

msoShapeMixed (-2)

msoShapeActionButtonForwardorNext (130)

msoShapeFlowchartMagneticDisk (86)

msoShapeMoon (24)

msoShapeActionButtonHelp (127)

msoShapeFlowchartManualInput (71)

msoShapeNoSymbol (19)

msoShapeActionButtonHome (126)

msoShapeFlowchartManualOperation (72)

msoShapeNotchedRightArrow (50)

msoShapeActionButtonInformation (128)

msoShapeFlowchartMerge (82)

msoShapeNotPrimitive (138)

msoShapeActionButtonMovie (136)

msoShapeFlowchartMultidocument (68)

msoShapeOctagon (6)

msoShapeActionButtonReturn (133)

msoShapeFlowchartOffpageConnector (74)

msoShapeOval (9)

msoShapeActionButtonSound (135)

msoShapeFlowchartOr (78)

msoShapeOvalCallout (107)

msoShapeArc (25)

msoShapeFlowchartPredefinedProcess (65)

msoShapeParallelogram (2)

msoShapeBalloon (137)

msoShapeFlowchartPreparation (70)

msoShapePentagon (51)

msoShapeBentArrow (41)

msoShapeFlowchartProcess (61)

msoShapePlaque (28)

msoShapeBentUpArrow (44)

msoShapeFlowchartPunchedTape (76)

msoShapeQuadArrow (39)

msoShapeBevel (15)

msoShapeFlowchartSequentialAccessStorage (85)

msoShapeQuadArrowCallout (59)

msoShapeBlockArc (20)

msoShapeFlowchartSort (80)

msoShapeRectangle (1)

msoShapeCan (13)

msoShapeFlowchartStoredData (83)

msoShapeRectangularCallout (105)

msoShapeChevron (52)

msoShapeFlowchartSummingJunction (77)

msoShapeRegularPentagon (12)

msoShapeCircularArrow (60)

msoShapeFlowchartTerminator (69)

msoShapeRightArrow (33)

msoShapeCloudCallout (108)

msoShapeFoldedCorner (16)

msoShapeRightArrowCallout (53)

msoShapeCross (11)

msoShapeHeart (21)

msoShapeRightBrace (32)

msoShapeCube (14)

msoShapeHexagon (10)

msoShapeRightBracket (30)

msoShapeCurvedDownArrow (48)

msoShapeHorizontalScroll (102)

msoShapeRightTriangle (8)

msoShapeCurvedDownRibbon (100)

msoShapeIsoscelesTriangle (7)

msoShapeRoundedRectangle (5)

msoShapeCurvedLeftArrow (46)

msoShapeLeftArrow (34)

msoShapeRoundedRectangularCallout (106)

msoShapeCurvedRightArrow (45)

msoShapeLeftArrowCallout (54)

msoShapeSmileyFace (17)

msoShapeCurvedUpArrow (47)

msoShapeLeftBrace (31)

msoShapeStripedRightArrow (49)

msoShapeCurvedUpRibbon (99)

msoShapeLeftBracket (29)

msoShapeSun (23)

msoShapeDiamond (4)

msoShapeLeftRightArrow (37)

msoShapeTrapezoid (3)

msoShapeDonut (18)

msoShapeLeftRightArrowCallout (57)

msoShapeUpArrow (35)

msoShapeDoubleBrace (27)

msoShapeLeftRightUpArrow (40)

msoShapeUpArrowCallout (55)

msoShapeDoubleBracket (26)

msoShapeLeftUpArrow (43)

msoShapeUpDownArrow (38)

msoShapeDoubleWave (104)

msoShapeLightningBolt (22)

msoShapeUpDownArrowCallout (58)

msoShapeDownArrow (36)

msoShapeLineCallout1 (109)

msoShapeUpRibbon (97)

msoShapeDownArrowCallout (56)

msoShapeLineCallout1AccentBar (113)

msoShapeUTurnArrow (42)

msoShapeDownRibbon (98)

msoShapeLineCallout1BorderandAccentBar (121)

msoShapeVerticalScroll (101)

msoShapeExplosion1 (89)

msoShapeLineCallout1NoBorder (117)

msoShapeWave (103)

msoShapeExplosion2 (90)

msoShapeLineCallout2 (110)

msoShapeFlowchartAlternateProcess (62)

msoShapeLineCallout2AccentBar (114)

The short program in Example A-1 will display each AutoShape, along with its AutoShapeType, for 0.5 seconds. (It should be run on a blank worksheet. You can interrupt this program at any time by striking Ctrl-Break.) The Delay subroutine that it calls is shown in Example A-2.

Example A-1. Displaying Each AutoShape 

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

Example A-2. The Delay Procedure 

Public Sub Delay(rTime As Single)
'Delay rTime seconds (min=.01, max=300)
Dim OldTime As Variant
'Safty net
If rTime < 0.01 Or rTime > 300 Then rTime = 1
OldTime = Timer
Do
    DoEvents
Loop Until Timer - OldTime >= rTime
End Sub

The TextFrame Object

Each Shape object has a text frame associated with it that holds any text associated with the object. The TextFrame property returns this TextFrame object.

The TextFrame object has a Characters property that returns a Characters collection. This collection can set the text in the text frame. For instance, the code in Example A-3 adds a rectangle to the active sheet and also adds text to the rectangle and sets the alignment for the text frame.

Example A-3. The AddRectangle Procedure 

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

The FillFormat Object

The FillFormat object sets various formatting for a Shape object. It is accessed using the Fill property of the Shape object. Among the properties of the FillFormat object are the BackColor, ForeColor, Pattern, and Visible properties. To set one of the color properties, we use the RGB color model, as in the following example: 

sh.Fill.ForeColor.RGB = RGB(0, 0, 255)

Examples

To illustrate the use of AutoShapes, Example A-4 inserts a dampened sine curve of small stars in the drawing layer.

Example A-4. DrawSine2, to Generate a Dampened Sine Curve of Small Stars 

Sub DrawSine2()
' Dampened sine wave of small stars
Const pi = 3.1416
Dim i As Integer
Dim x As Single, y As Single
Dim rng As Range     ' For starting point
Dim n As Single      ' Cycle length in inches
Dim k As Integer     ' k stars
Dim ScaleY As Single ' Vertical scaling
Dim sSize As Single  ' Star size
Dim sDamp1 As Single  ' Dampening factor
Dim sDamp2 As Single  ' Dampening factor
Dim cCycles As Integer  ' Number of cycles
Dim sh As Shape
Dim StartLeft As Integer
Dim StartTop As Integer

' Starting position
StartLeft = ActiveCell.Left
StartTop = ActiveCell.Top

cCycles = 3
sDamp1 = 1
sDamp2 = 0.2
n = 2
k = 20
ScaleY = 0.5
sSize = Application.InchesToPoints(0.1)
' Loop for first curve with phase shift
For i = 1 To cCycles * k
   x = n * i / k
   y = ScaleY * Sin((2 * pi * i) / k + n) * _
      (sDamp1 / (x + sDamp2))
   y = Application.InchesToPoints(y)
   x = Application.InchesToPoints(x)
   Set sh = ActiveSheet.Shapes.AddShape _
      (msoShape5pointStar, StartLeft + x, StartTop + y, sSize, sSize)
   sh.Fill.ForeColor.RGB = RGB(192, 192, 192)  ' 25% gray
   sh.Fill.Visible = msoTrue
Next i
End Sub

The output from this code is shown in Figure A-3.

A dampened sine wave of stars

Figure A-3. A dampened sine wave of stars

The code in Example A-5 produces a random series of stars, each containing a single letter that together spells a name. Note that each time the program is run, the pattern is different.

Example A-5. Code to Produce a Random Series of Stars 

Sub DrawName()

' Random placement of large stars with name
Const pi = 3.1416
Dim i As Integer
Dim x As Single, y As Single
Dim z As Single
Dim rng As Range     ' For starting point
Dim n As Single      ' Cycle length in inches
Dim k As Integer     ' k stars
Dim sSize As Single  ' Star size
Dim sh As Shape
Dim sName As String  ' Name to display
Dim StartLeft As Integer
Dim StartTop As Integer

' Starting position
StartLeft = ActiveCell.Left
StartTop = ActiveCell.Top

sName = "Steven Roman"
n = 5
k = Len(sName)
sSize = Application.InchesToPoints(0.5)

Randomize Timer
z = 0#
' Loop for first curve with phase shift
For i = 1 To k
   If Mid(sName, i, 1) <> " " Then
      x = n * i / k
      x = Application.InchesToPoints(x)
      
      ' Get random 0 or 1. Go up or down accordingly.
      If Int(2 * Rnd) = 0 Then
         z = z + 0.2
      Else
         z = z - 0.2
      End If
      y = Application.InchesToPoints(z)
      Set sh = ActiveSheet.Shapes.AddShape _
         (msoShape5pointStar, StartLeft + x, StartTop + y, sSize, sSize)
      
      ' Add shading
      sh.Fill.ForeColor.RGB = RGB(230, 230, 230)
      sh.Fill.Visible = msoTrue
         
      ' Add text
      sh.TextFrame.Characters.Text = Mid(sName, i, 1)
      sh.TextFrame.Characters.Font.Size = 10
      sh.TextFrame.Characters.Font.Name = "Arial"
      sh.TextFrame.Characters.Font.Bold = True
      
   End If
Next i
End Sub

The output from this code is shown in Figure A-4.

Random stars spelling a name

Figure A-4. Random stars spelling a name

Example A-6 prints a hypocycloid. (It may take a few minutes to complete.)

Example A-6. The DrawHypocycloid Procedure 

Sub DrawHypocycloid()

' Draw hypocycloid of small stars
Const pi = 3.1416
Dim t As Single
Dim i As Integer
Dim x As Single, y As Single
Dim rng As Range     ' For starting point
Dim n As Single
Dim k As Integer
Dim sSize As Single  ' Star size
Dim r As Integer
Dim r0 As Integer
Dim R1 As Integer
Dim sh As Shape
Dim sc As Single
Dim StartLeft As Integer
Dim StartTop As Integer

' Starting position
StartLeft = ActiveCell.Left
StartTop = ActiveCell.Top

r = 1
r0 = 3 * r
R1 = 8 * r
n = 400
k = 4
sc = 0.1
sSize = Application.InchesToPoints(0.03)
' Start curve at insertion point
Set rng = ActiveCell
For i = 1 To n
   t = k * pi * i / n
   x = (R1 - r) * Cos(t) + r0 * Cos(t * (R1 - r) / r)
   y = (R1 - r) * Sin(t) - r0 * Sin(t * (R1 - r) / r)
   x = sc * x
   y = sc * y
   x = Application.InchesToPoints(x)
   y = Application.InchesToPoints(y)
   Set sh = ActiveSheet.Shapes.AddShape _
            (msoShape5pointStar, StartLeft + x, StartTop + y, sSize, sSize)
Next i
End Sub

The results are shown in Figure A-5. (The small vertical bar in Figure A-5 indicates the left edge of the active cell.

A hypocycloid

Figure A-5. A hypocycloid