GDG Macros Lesson 10: A single UNDO using CommandGroups and Optimization for Macro SPEED!

Hi.

Here's the code for meantime.

~John

Option Explicit

Sub messWithShape()
    Dim s As Shape
    Dim sr As ShapeRange, sr2 As New ShapeRange
    Dim i As Long, w#, h#
   
    ActiveDocument.BeginCommandGroup "messin around"
    Optimization = True
    Set sr = ActivePage.Shapes.All
   
    For i = 1 To sr.Count
        Set s = sr(i)
        'If s.SizeWidth > 2 Then
            sr2.Add doItToIt(s, w, h)
        'End If
    Next i
   
    sr2.CreateSelection
    Optimization = False
    ActiveWindow.Refresh
    ActiveDocument.EndCommandGroup
End Sub

Private Function doItToIt(ByVal s As Shape, ByRef w As Double, h#) As Shape
    s.Fill.UniformColor.CMYKAssign getRandomNumber(1, 100), getRandomNumber(1, 100), getRandomNumber(1, 100), getRandomNumber(1, 100)
    s.Rotate getRandomNumber(0, 360)
    'w = s.SizeWidth
    'h = s.SizeHeight
    's.GetSize w, h
    Set doItToIt = s
End Function

Private Function getRandomNumber&(nLow&, nHigh&)
    Dim n1&
    Randomize
    n1 = CLng((nHigh - nLow) * VBA.Rnd + nLow)
    If n1 < nLow Then n1 = nLow
    If n1 > 100 Then n1 = nHigh

    getRandomNumber = n1
End Function