Microsoft Office Forums - View Single Post - [Solved] Macro optimization

donsnow · 10-31-2017, 05:34 AM

Hello all,

I've written a small macro that does the following:

put the level 5 headings from a document in a table at a certain location in the same document
insert section breaks at certain places in the document
change the page orientation for certain sections
remove some empty paragraphs to get rid of blank pages

It works more or less as I want it to, however, the problems is that I need to use it on large documents (~600 pages, containing a couple of hundreds of heading5s), which either takes a long time or crashes Word.
My question is if it is possible to do this in a more optimal way. This is the first time I'm fiddling with VBA, so I don't really know how to approach this performance issue.

See my code below, any input is appreciated!

Code:

Sub InsertTable()
    Dim tempTable As Paragraph
    Dim lineCount As Long
    
    Application.ScreenUpdating = False
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    
    lineCount = 0
    strTableloc = "INSERT TABLE HERE"
    strSection2start = "SECTION 2 START"
    strSection2end = "SECTION 2 END"
    strSection4start = "SECTION 4 START"
    strSection4end = "SECTION 4 END"
    
    For Each tempTable In ActiveDocument.Paragraphs
     If tempTable.Style = ActiveDocument.Styles(wdStyleHeading5) Then
        tempTable.Range.Editors.Add wdEditorEveryone
        lineCount = lineCount + 1
     End If
    Next
    
    ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    Selection.Copy
    Set rng1 = ActiveDocument.Range
    With rng1
        With .Find
            .Text = strTableloc
            If .Execute = True Then
                ActiveDocument.Range(rng1.Start, rng1.End).Select
            End If
        End With
    End With

    Selection.TypeParagraph
    Selection.PasteAndFormat (wdFormatPlainText)
    'select the whole list
    Selection.MoveUp Unit:=wdLine, Count:=lineCount, Extend:=wdExtend
    'create table from the list
    Selection.ConvertToTable Separator:=wdSeparateByTabs, _
        NumColumns:=6, NumRows:=lineCount ', AutoFitBehavior:=wdAutoFitFixed
    With Selection.Tables(1)
        .ApplyStyleHeadingRows = True
        .ApplyStyleLastRow = False
        .ApplyStyleFirstColumn = True
        .ApplyStyleLastColumn = False
        .LeftPadding = 0
        .RightPadding = 0
    End With
    
    Selection.Cut
    Selection.PasteAppendTable
    
    InsertSectionBrake strSection2start
    InsertSectionBrake strSection2end
    InsertSectionBrake strSection4start
    InsertSectionBrake strSection4end
    
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToAbsolute, Count:=2
    Selection.PageSetup.Orientation = wdOrientLandscape
    Selection.GoTo What:=wdGoToSection, Which:=wdGoToAbsolute, Count:=4
    Selection.PageSetup.Orientation = wdOrientLandscape
    
    ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    Application.ScreenUpdating = True
    
End Sub

Sub InsertSectionBrake(reference)

    Set rng1 = ActiveDocument.Range
        With rng1
            With .Find
                .Text = reference
                If .Execute = True Then
                    ActiveDocument.Range(rng1.Start, rng1.End).Select
                End If
            End With
        End With
        
    Selection.InsertBreak Type:=wdSectionBreakNextPage
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=2

End Sub

To get into specifics:

I attached a sample document
I need the sections because in one of them there is a picture that fits better in landscape. In another section, the table that the macro creates also fits only in a landscape page.
The contents of the document are given and shouldn't be modified, I must only add this table containing all the heading 5 items.
The structure of the document doesn't change, and as far as my tests went until now, the macro managed to keep the correct headers and footers, so for the beginning I would stick with the existing solution,

Thanks again for your help.