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