Previous post
OK, here are some of the promised basics of using VBA to create drawings in Excel.
This and following posts will cover:
- The shape objects and how to create them
- How to select, group, and delete shapes
- How to modify existing shapes
- How to get the properties of existing shapes
- How to scale shapes
- How to create 3D perspective wireframe drawings
There are two main problems with creating code driven drawings in Excel:
- There are several alternative ways to do almost everything, and the ways they work are not always obvious (at least to me), and there are significant difference between versions.
- The documentation is sparse, and what there is is often far from helpful. To make matters worse, there is little on the subject in the popular Excel books, and even web sites covering the topic are few and far between.
In the rest of this post I will list the available VBA methods that apply to shape objects, then look at some examples of how these methods work in practice.
The methods applicable to shapes are:
- AddCallout
- AddChart
- AddConnector
- AddCurve
- AddFormControl
- AddLabel
- AddLine
- AddOLEObject
- AddPicture
- AddPolyline
- AddShape
- AddTextbox
- AddTextEffect
- BuildFreeform
- SelectAll
The ones I will be concentrating on are:
- AddCurve
- AddLine
- AddPolyline
- AddShape
- AddTextbox
Which will give us more than enough for what we want to do.
The examples given below can be found in: Plot Shapes.zip
The examples are based on drawing similar dodecagons (regular 12 sided polygons) by various methods. The coordinates defining the shapes are listed on the spreadsheet, we will be looking at how screen coordinates work more closely in a later post. For now just note that the shapes are defined by 12 x,y coordinates, with the first point repeated at the end of the list, to create a closed shape. There are also 4 straight lines, defined by the start and end points.
Sub ExShapeAdd()
Dim PointArray() As Single, CoordA As Variant, shp As Shape, i As Long, ffshp As Shape
Dim myBuilder As FreeformBuilder, XNode As Single, YNode As Single
ShapeDelete ‘Routine to delete old shapes, see later post
CoordA = [a1:b13] ‘ Get coordinates array from the worksheet
‘ AddLine
With ActiveSheet.Shapes.AddLine(CoordA(1, 1), CoordA(1, 2), CoordA(7, 1), CoordA(7, 2))
.Name = “straight”
.Line.Weight = 2
.Line.ForeColor.SchemeColor = 8
End With
‘Plot the same line and rotate through 45 degrees
With ActiveSheet.Shapes.AddLine(CoordA(1, 1), CoordA(1, 2), CoordA(7, 1), CoordA(7, 2))
.Name = “straight-a”
.Rotation = 90
End With
‘ Copy CoordA (variant) into PointArray (single)
ReDim PointArray(1 To 13, 1 To 2)
For i = 1 To 13
PointArray(i, 1) = CoordA(i, 1)
PointArray(i, 2) = CoordA(i, 2)
Next i
‘ AddCurve
Set shp = ActiveSheet.Shapes.AddCurve(PointArray)
With shp
.Fill.Visible = False
.Name = “Curve1”
End With
With ActiveSheet.Shapes.AddCurve(PointArray)
.Fill.Visible = False
.Rotation = 45
.Name = “Curve2”
End With
AddCurve
CoordA = [a15:b27]
' AddShape; 183 = straight connector
ActiveSheet.Shapes.AddShape(183, CoordA(7, 1), CoordA(1, 2), CoordA(1, 1) - CoordA(7, 1), CoordA(7, 2) - CoordA(1, 2)).Name = "Straight2"
With ActiveSheet.Shapes.AddShape(183, CoordA(7, 1), CoordA(1, 2), CoordA(1, 1) - CoordA(7, 1), CoordA(7, 2) - CoordA(1, 2))
.Name = "Straight2-A"
.Rotation = 90
End With
For i = 1 To 13
PointArray(i, 1) = CoordA(i, 1)
PointArray(i, 2) = CoordA(i, 2)
Next i
‘ AddPolyLine
ActiveSheet.Shapes.AddPolyline(PointArray).Fill.Visible = False
AddPolyLine
CoordA = [a29:b41]
For i = 1 To 13
PointArray(i, 1) = CoordA(i, 1)
PointArray(i, 2) = CoordA(i, 2)
Next i
‘ Shapebuilder
‘ first point
XNode = PointArray(1, 1)
YNode = PointArray(1, 2)
Set myBuilder = ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, XNode, YNode)
‘ remaining points
For i = 2 To 13
XNode = PointArray(i, 1)
YNode = PointArray(i, 2)
myBuilder.AddNodes msoSegmentLine, msoEditingAuto, XNode, YNode
Next
Set ffshp = myBuilder.ConvertToShape
ffshp.Name = “Built-shape”
BuilFreeForm
CoordA = [a44:a47]
' AddShape; 146 = dodecagon
ActiveSheet.Shapes.AddShape(146, CoordA(1, 1), CoordA(2, 1), CoordA(3, 1), CoordA(4, 1)).Name = "Shape2"
End Sub
Newton Excel Bach, not (just) an Excel Blog 