View Single Post
Old 30-01-2015, 23:17
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Artistic Media


I took your sample file and duplicated the artistic media twice so I had a total of three sets or 102 objects. This gave me a good baseline to test speed. With the macro you posted it would take about 40 - 45 seconds to remove all the control paths.

With my version that I will post below I have this time down to about .045 seconds. Mileage will vary of course depending on your CPU, RAM, and if you are 64-bit. But it should be a little quicker. ;-)

Sub ClearPathArtisticMedia()
    Dim s As Shape
    Dim sr As ShapeRange, srControlPath As New ShapeRange

    Optimization = True
    ActiveDocument.BeginCommandGroup "Clear Artistic Media Paths"
    EventsEnabled = False
    ActiveDocument.PreserveSelection = False
    On Error GoTo ErrHandler
        Set sr = ActiveSelectionRange.Shapes.FindShapes(, cdrArtisticMediaGroupShape)
        For Each s In sr
            srControlPath.Add s.Previous
        Next s
    ActiveDocument.PreserveSelection = True
    EventsEnabled = True
    Optimization = False
    Exit Sub

    MsgBox "Error occured: " & Err.Description
    Resume ExitSub
End Sub
For fun I did, 30 sets or 1020 objects and it took about 1.26 seconds. ;-)

Hopefully that helps,


Last edited by shelbym; 30-01-2015 at 23:23.
Reply With Quote