Saturday, May 09, 2009

VBA for Powerpoint

I like to create figures for presentations or papers in Powerpoint 2007, it's just such a simple tool to use, and since I have no design talent the default templates are a god-send.

Often it is difficult to create the effect you need, but thats where the hidden power of macros comes in.

Here are two Powerpoint 2007 macros, one for creating a regular grid of rectangles, another for creating random dots. Both work inside a given shape for all your spotted object needs be it a dalmatian, to a chessboard, to creating diagrams of Eulerian and Lagrangian fluid representations.

(NOTE: I don't actually understand VBA script, I just hobbled it together from examples on the web.)

Sub grid()

Dim oSh As Shape
Dim oSld As Slide
Dim sngWidth As Single ' width/height of a grid rect
Dim sngHeight As Single
Dim lCols As Long
Dim lRows As Long
Dim x As Long ' which col across are we making
Dim y As Long ' which row down are we making
Dim sngLeft As Single ' where to draw current rectangle
Dim sngTop As Single
Dim sTemp As String

If Not ActiveWindow.Selection.Type = ppSelectionShapes Then
MsgBox "Select something, then try again"
Exit Sub
End If

' get rows/cols from user
sTemp = InputBox("How many columns?", "Columns")
If CLng(sTemp) > 0 Then
lCols = CLng(sTemp)
sTemp = InputBox("How many rows?", "Rows")
If CLng(sTemp) > 0 Then
lRows = CLng(sTemp)
Else
Exit Sub
End If
Else
Exit Sub
End If

Set oSh = ActiveWindow.Selection.ShapeRange(1)
Set oSld = oSh.Parent

sngWidth = oSh.Width / lCols
sngHeight = oSh.Height / lRows

For x = 0 To lCols - 1
For y = 0 To lRows - 1
' with osld.Shapes.AddShape(msoShapeRectangle, left, top, width, height)
With oSld.Shapes.AddShape(msoShapeRectangle, oSh.Left + x * sngWidth, oSh.Top + y * sngHeight, sngWidth, sngHeight)
Call .Tags.Add("Grid", "YES")
End With
Next
Next

End Sub

Sub spots()
Dim oSh As Shape
Dim oSld As Slide

If Not ActiveWindow.Selection.Type = ppSelectionShapes Then
MsgBox "Select something, then try again"
Exit Sub
End If


Set oSh = ActiveWindow.Selection.ShapeRange(1)
Set oSld = oSh.Parent
For x = 0 To 50
With oSld.Shapes.AddShape(msoShapeOval, oSh.Left + oSh.Width * Rnd, oSh.Top + oSh.Height * Rnd, 10, 10)
Call .Tags.Add("Grid", "YES")
End With
Next
End Sub

No comments: