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