Sub PunctuationToDoubleQuote()
' Paul Beverley - Version 19.11.21
' Changes next quote mark to double curly

trackit = True

myTrack = ActiveDocument.TrackRevisions
If trackit = False Then ActiveDocument.TrackRevisions = False

searchChars = Chr(34) & Chr(39) & ChrW(8216) & ChrW(8217) _
       & ChrW(8220) & ChrW(8221) & ChrW(8249) & ChrW(8250) _
       & ChrW(8222) & ChrW(8218) & ChrW(171) & ChrW(187) _
       & ChrW(96) & ChrW(8242) & ChrW(8243)

Set rng = Selection.Range.Duplicate
rng.End = ActiveDocument.Content.End
If Len(rng) > 1000 Then rng.End = rng.Start + 1000

For Each ch In rng.Characters
  If InStr(searchChars, ch.Text) > 0 Then
    ch.Select
    gotChar = True
    Exit For
  Else
  End If
Next ch
If gotChar = False Then
  Beep
  ActiveDocument.TrackRevisions = myTrack
  Exit Sub
End If

Selection.Collapse wdCollapseStart

optNow = Options.AutoFormatAsYouTypeReplaceQuotes
Options.AutoFormatAsYouTypeReplaceQuotes = True

With Selection.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = ch
  .Replacement.Text = """"
  .Execute Replace:=wdReplaceOne
End With
Selection.Collapse wdCollapseEnd

Options.AutoFormatAsYouTypeReplaceQuotes = optNow
ActiveDocument.TrackRevisions = myTrack
End Sub