View Single Post
 
Old 06-01-2021, 09:23 PM
Cendrinne's Avatar
Cendrinne Cendrinne is offline Windows 10 Office 2019
Competent Performer
 
Join Date: Aug 2019
Location: Montreal Quebec Canada
Posts: 200
Cendrinne is on a distinguished road
Default

I've added other stuff to fix paragraph endings. On a 11 pages of paragraphs, it took 5 min. Is there anyway, to speed it up? Why is it taking so long?


Code:
    Application.ScreenUpdating = False
    
    TST_End_of_Sentence_                                            'suggested by Guessed
    
    Options.DefaultHighlightColorIndex = wdBrightGreen
    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = True
        .MatchWildcards = True
    
        .Text = "(\(*>)^32"
        .Replacement.Text = "\1^s"                                  'suggested by Macropod
        .Execute Replace:=wdReplaceAll
    
        .Text = "(*>)^32(A-Z)"
        .Replacement.Text = "\1^s\2"
        .Execute Replace:=wdReplaceAll
    
    Options.DefaultHighlightColorIndex = wdYellow
    
        .Text = "(«)^32(<*)"                                            '«
        .Replacement.Text = "\1^s\2"
        .Execute Replace:=wdReplaceAll
    
        .Text = "(>)^32(»)"                                            '»
        .Replacement.Text = "\1^s\2"
        .Execute Replace:=wdReplaceAll
        
        .Text = "([%$])"                                               '$%
        .Replacement.Text = "^s\1"
        .Execute Replace:=wdReplaceAll
    
    Options.DefaultHighlightColorIndex = wdTurquoise
    
        .Text = "([0-9]>)^32(millio[ns]@)"                             '0-9 millions
        .Replacement.Text = "\1^s\2"
        .Execute Replace:=wdReplaceAll
    
        .Text = "(rie>)^32([A-Z0-9])"                                  'serie 0-9 / categorie A-Z
        .Replacement.Text = "\1^s\2"
        .Execute Replace:=wdReplaceAll
    
        .Text = "([0-9]{4})-([0-9])"
        .Replacement.Text = "\1^~\2"
        .Execute Replace:=wdReplaceAll

        .Text = "([0-9]>) (<[adfjmnos])"                           'Months
        .Replacement.Text = "\1^s\2"
        .Execute Replace:=wdReplaceAll
    
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'Reset Find and Replace    
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = True
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    Application.ScreenUpdating = True
Reply With Quote