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

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

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”

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

Very cool, I have to say I’m totally intrigued by the idea of doing 3d in Excel. It’s an idea that’s so bad it’s good =) Reminds me of the Excel Media Player (http://blogs.msdn.com/excel/archive/2008/04/14/building-the-excel-media-player-part-1.aspx ).

LikeLike

OK – I guess that doing 3D drawing in Excel might seem a little weird to most people, but I do actually have a good reason for doing it.🙂

By the way, have you seen:

http://www.gamasutra.com/view/feature/3563/microsoft_excel_revolutionary_3d_.php

?

LikeLike

That’s awesome. I’d love to just put one of those spinning cubes in in place of my typical “Please wait…” message when accessing a database or something😛

LikeLike

Pingback: Drawing in Excel-4 « Newton Excel Bach, not (just) an Excel Blog

we are two friends who actively draw using Excel in our spare time. We thing we have similar interest here. You are all invited to join our group at Facebook, please follow this link http://www.facebook.com/home.php?#/group.php?gid=74360864077&ref=nf We are looking forward to meeting you there.

LikeLike

Pingback: Daily Download 8: Drawing in Excel | Newton Excel Bach, not (just) an Excel Blog