View Single Post
 
Old 02-06-2022, 11:27 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2019
Expert
 
Join Date: Aug 2014
Posts: 4,138
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Word documents are made up of several story ranges. Imagine if you will a pile of transparencies, each containing part of the document.

The principle story range is the ActiveDocument.Range which contains all the text in the document body. However the document may have headers/footers/text boxes/tables/graphics etc. If these are relevant, you would need to amend the code to loop through all the available story ranges. Unfortunately that won't work for autoformat. The following will loop through the ranges and call FixSpace. You may still find it necessary to address issues on an individual basis by adding to he FixSpace macro. Much depends on the complexity of the document.
Code:
Sub Find_Replace()
Dim oDoc As Document
Dim oShp As Shape
Dim sFormat As Boolean
Dim oStory As Range
    
    Set oDoc = ActiveDocument
    sFormat = Options.AutoFormatAsYouTypeReplaceQuotes
    Options.AutoFormatReplaceQuotes = True
    oDoc.Range.AutoFormat
    Options.AutoFormatAsYouTypeReplaceQuotes = sFormat
    
    For Each oStory In oDoc.StoryRanges
        Select Case oStory.StoryType
            Case 1 To 11
                Do
                    FixSpace oStory
                    DoEvents
                    Select Case oStory.StoryType
                        Case 6, 7, 8, 9, 10, 11
                            If oStory.ShapeRange.Count > 0 Then
                                For Each oShp In oStory.ShapeRange
                                    If oShp.TextFrame.HasText Then
                                        FixSpace oShp.TextFrame.TextRange
                                    End If
                                    DoEvents
                                Next oShp
                            End If
                        Case Else
                            'Do Nothing
                    End Select
                    'Get next linked story (if any)
                    Set oStory = oStory.NextStoryRange
                Loop Until oStory Is Nothing
            Case Else
        End Select
        DoEvents
    Next oStory
lbl_Exit:
    Set oStory = Nothing
    Set oDoc = Nothing
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote