Adding a wait time to sub

TimWM88
11 months ago

Update: Solution was found by the suggestion from Shelby Moore

.Hey there, So I have created a VBA macro, and I could use some feedback and advice on how to correct a crashing issue. The outline of the macro is below.

  1. The Macro loops through each page in a document.
  2. On each page it ungroups all groups.
  3. Finds the two objects named "Male Arc" & "Male Notch".
  4. Then it Recolors, groups, and rotates the group.

This works fine on smaller files with around 50 pages but when I tried a production document with around 400 pages it made CorelDraw crash.

I was thinking if I could add a delay on each page, it might help and not send the program it an unresponsive state then crash.

Any advice on how to resolve this would be greatly appreciated.

Parents
No Data
Reply
  • 11 months ago

    I do not think that adding a delay is going to help. The most common reason for a crash that I have seen when working with large documents is running out of memory. I would run your code and watch the memory and see what is going on.

    To help address this turn on Optimization and turn off Events while your code is running. 

    Here is an example of how to do that. Make sure that when you are using Optimization you have an On Error GoTo, because if your code errors out and you do not turn optimization off strange things will happen or will not happen. Try it once and you will see what I mean. LOL 

    Sub Group_on_Selected_Rectangles()
    Dim srSelection As ShapeRange, srRectangles As ShapeRange
    Dim sRect As Shape
    
    Set srSelection = ActiveSelectionRange
    If srSelection.Shapes.Count > 1 Then MsgBox "Please only select one shape.": Exit Sub

    On Error GoTo ErrHandler
    
    ActiveDocument.BeginCommandGroup "Group objects on selected rectangles"
    EventsEnabled = False
    Optimization = True
    
    Set srRectangles = ActivePage.Shapes.FindShapes(Query:="@width = {" & srSelection(1).SizeWidth & " in } and @height ={" & srSelection(1).SizeHeight & " in }")
    
    For Each sRect In srRectangles
       ActivePage.SelectShapesFromRectangle sRect.LeftX, sRect.BottomY, sRect.RightX, sRect.TopY, False
       ActiveSelectionRange.Group
    Next sRect

ExitSub:
    ActiveDocument.ClearSelection
    Optimization = False
    EventsEnabled = True
    ActiveDocument.EndCommandGroup
    Refresh
    Exit Sub

ErrHandler:
    MsgBox "Error occurred: " & Err.Description
    Resume ExitSub
End Sub


    Happy coding, 

    -Shelby

Children

© Corel Corporation. All rights reserved. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms of Use / Privacy​ ​/ ​Cookies / Terms and Conditions / User Guidelines.