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


Can not upload video. Video too large.

Re-created video in 2 parts here:




  • Hi.

    Here's the code for meantime.




    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
        Optimization = False
    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&
        n1 = CLng((nHigh - nLow) * VBA.Rnd + nLow)
        If n1 < nLow Then n1 = nLow
        If n1 > 100 Then n1 = nHigh

        getRandomNumber = n1
    End Function


Reply Children