View Single Post
  #6  
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

Patti,

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. ;-)

Code:
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.SaveSettings
    ActiveDocument.PreserveSelection = False
    On Error GoTo ErrHandler
    
        Set sr = ActiveSelectionRange.Shapes.FindShapes(, cdrArtisticMediaGroupShape)
        
        For Each s In sr
            srControlPath.Add s.Previous
            s.Separate
        Next s
        
        srControlPath.Delete
   
ExitSub:
    ActiveDocument.PreserveSelection = True
    ActiveDocument.RestoreSettings
    EventsEnabled = True
    Optimization = False
    ActiveDocument.ClearSelection
    ActiveWindow.Refresh
    Application.Refresh
    ActiveDocument.EndCommandGroup
    Exit Sub

ErrHandler:
    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,

-Shelby

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