错误拼写单词的宏自动更正

Question

我尝试在MS Word中创建一个宏，以便在将文件提交到谷歌翻译之前正确格式化.pdf文档中的文本。我设法删除了分段符号和短划线，但我没有设法仅抑制拼写错误的单词之间的空格。这是我到目前为止尝试的内容，基于我在网上可以找到的内容（这是我第一次使用宏）：

Sub AutoCorrectV1()
' Justify text
Selection.ParagraphFormat.Alignment = 3
' suppress paragraph breaks
Dim TextToFind1 As String
    TextToFind1 = "^p"
    Dim TextToReplace1 As String
    TextToReplace1 = ""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = TextToFind1
        .Replacement.Text = TextToReplace1
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
' Suppress dashes
' This one still need to be perfected because in German for example I don't want strings like "- " to be wiped out
Dim TextToFind2 As String
    TextToFind2 = " - "
    Dim TextToReplace2 As String
    TextToReplace2 = ""
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = TextToFind2
        .Replacement.Text = TextToReplace2
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll 
' Correct all misspellings
Dim wd As Range
Dim Oldtxt As String
Dim Newtxt As String
Dim Sugg As SpellingSuggestions
Dim AddSpace As String
    Application.ScreenUpdating = False
    For Each wd In ActiveDocument.Words
        Oldtxt = wd.Text
            If Not Application.CheckSpelling(Word:=Oldtxt, IgnoreUppercase:=True) Then
                Set Sugg = Application.GetSpellingSuggestions(Oldtxt)
                If Sugg.Count <> 0 Then
                        Newtxt = Application.GetSpellingSuggestions(Oldtxt).Item(1)
                        If Right(Oldtxt, 1) = " " Then
                            AddSpace = " "
                        Else
                            AddSpace = ""
                        End If
                        wd.Text = Newtxt & AddSpace
                End If
            End If
    Next wd
    Application.ScreenUpdating = True
End Sub