Macro clean-up help,please

[Ulodesk]

I am no coder. I recorded this macro and am certain it could be simpler. Help, please?

Sub SmartQuotesToStraight()
'
' Changes Smart Quotes to Straight. Entire document.
'

    With Options
        .AutoFormatAsYouTypeApplyHeadings = False
        .AutoFormatAsYouTypeApplyBorders = False
        .AutoFormatAsYouTypeApplyBulletedLists = False
        .AutoFormatAsYouTypeApplyNumberedLists = False
        .AutoFormatAsYouTypeApplyTables = False
        .AutoFormatAsYouTypeReplaceQuotes = False
        .AutoFormatAsYouTypeReplaceSymbols = False
        .AutoFormatAsYouTypeReplaceOrdinals = True
        .AutoFormatAsYouTypeReplaceFractions = True
        .AutoFormatAsYouTypeReplacePlainTextEmphasis = False
        .AutoFormatAsYouTypeReplaceHyperlinks = True
        .AutoFormatAsYouTypeFormatListItemBeginning = False
        .AutoFormatAsYouTypeDefineStyles = False
        .TabIndentKey = False
    End With
    With AutoCorrect
        .CorrectInitialCaps = True
        .CorrectSentenceCaps = True
        .CorrectDays = True
        .CorrectCapsLock = True
        .ReplaceText = True
        .ReplaceTextFromSpellingChecker = True
        .CorrectKeyboardSetting = False
        .DisplayAutoCorrectOptions = True
        .CorrectTableCells = True
    End With
    With Options
        .AutoFormatApplyHeadings = False
        .AutoFormatApplyLists = False
        .AutoFormatApplyBulletedLists = False
        .AutoFormatApplyOtherParas = False
        .AutoFormatReplaceQuotes = True
        .AutoFormatReplaceSymbols = False
        .AutoFormatReplaceOrdinals = True
        .AutoFormatReplaceFractions = True
        .AutoFormatReplacePlainTextEmphasis = True
        .AutoFormatReplaceHyperlinks = True
        .AutoFormatPreserveStyles = True
        .AutoFormatPlainTextWordMail = True
    End With
    Options.LabelSmartTags = False
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = """"
        .Replacement.Text = """"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "'"
        .Replacement.Text = "'"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Options
        .AutoFormatAsYouTypeApplyHeadings = False
        .AutoFormatAsYouTypeApplyBorders = False
        .AutoFormatAsYouTypeApplyBulletedLists = False
        .AutoFormatAsYouTypeApplyNumberedLists = False
        .AutoFormatAsYouTypeApplyTables = False
        .AutoFormatAsYouTypeReplaceQuotes = True
        .AutoFormatAsYouTypeReplaceSymbols = False
        .AutoFormatAsYouTypeReplaceOrdinals = True
        .AutoFormatAsYouTypeReplaceFractions = True
        .AutoFormatAsYouTypeReplacePlainTextEmphasis = False
        .AutoFormatAsYouTypeReplaceHyperlinks = True
        .AutoFormatAsYouTypeFormatListItemBeginning = False
        .AutoFormatAsYouTypeDefineStyles = False
        .TabIndentKey = False
    End With
    With AutoCorrect
        .CorrectInitialCaps = True
        .CorrectSentenceCaps = True
        .CorrectDays = True
        .CorrectCapsLock = True
        .ReplaceText = True
        .ReplaceTextFromSpellingChecker = True
        .CorrectKeyboardSetting = False
        .DisplayAutoCorrectOptions = True
        .CorrectTableCells = True
    End With
    With Options
        .AutoFormatApplyHeadings = False
        .AutoFormatApplyLists = False
        .AutoFormatApplyBulletedLists = False
        .AutoFormatApplyOtherParas = False
        .AutoFormatReplaceQuotes = True
        .AutoFormatReplaceSymbols = False
        .AutoFormatReplaceOrdinals = True
        .AutoFormatReplaceFractions = True
        .AutoFormatReplacePlainTextEmphasis = True
        .AutoFormatReplaceHyperlinks = True
        .AutoFormatPreserveStyles = True
        .AutoFormatPlainTextWordMail = True
    End With
    Options.LabelSmartTags = False
End Sub

[gmaxey]

I use this:

Sub ConvertQuoteFormat()
Dim rngstory As Word.Range
Dim pAction As String
Dim bSQSetting As Boolean
  'Stores users AutoCorrect "smart quote" options.  True if enabled
  bSQSetting = Options.AutoFormatAsYouTypeReplaceQuotes
  pAction = InputBox("Enter ""1"" to convert ""straight quotes"" to ""smart quotes.""" _
          & vbCr + vbCr & "Enter ""2"" to convert ""smart quotes"" to ""straight quotes.""", _
          "Action", "1")
  If pAction = "1" Then
    'Convert to curly
    Options.AutoFormatAsYouTypeReplaceQuotes = True
    For Each rngstory In ActiveDocument.StoryRanges
      Do
        If rngstory.StoryLength >= 2 Then
          CurlyQuoteToggle rngstory
        End If
        Set rngstory = rngstory.NextStoryRange
      Loop Until rngstory Is Nothing
    Next
    If bSQSetting = False Then
      If MsgBox("Do you want to format new text entered in this document using ""smart qoutes?""", vbQuestion + vbYesNo, "AutoFormat") = vbYes Then
        Options.AutoFormatAsYouTypeReplaceQuotes = True
        bSQSetting = Options.AutoFormatAsYouTypeReplaceQuotes
      End If
    End If
  Else
    'Convert to straight
    Options.AutoFormatAsYouTypeReplaceQuotes = False
    For Each rngstory In ActiveDocument.StoryRanges
      Do
        If rngstory.StoryLength >= 2 Then
         CurlyQuoteToggle rngstory
        End If
        Set rngstory = rngstory.NextStoryRange
      Loop Until rngstory Is Nothing
    Next
    If bSQSetting = True Then
      If MsgBox("Do you want to format new text entered in this document using ""straight qoutes?""", vbQuestion + vbYesNo, "AutoFormat") = vbYes Then
        Options.AutoFormatAsYouTypeReplaceQuotes = False
        bSQSetting = Options.AutoFormatAsYouTypeReplaceQuotes
      End If
    End If
  End If
  Options.AutoFormatAsYouTypeReplaceQuotes = bSQSetting
lbl_Exit:
  Exit Sub
End Sub

Sub CurlyQuoteToggle(ByVal rngstory As Word.Range)
With rngstory.Find
  'quote marks
  .Text = Chr$(34)
  .Replacement.Text = Chr$(34)
  .Execute Replace:=wdReplaceAll
  'apostrophe
  .Text = Chr$(39)
  .Replacement.Text = Chr$(39)
  .Execute Replace:=wdReplaceAll
End With
End Sub

[Ulodesk]

Thanks, Greg. I was thinking that all the "auto format as you type" lines were probably unnecessary. In any case, both macros work.