Question

我有这个VBA代码，它需要两个文件（一个原始文档和一个带有蓝色文本的修订文档）并创建第三个文件和修订版。它主要是有效的，但是当创建第三个副本时，有撇号后的额外空间。它实际上并不是一个额外的空间。在Word中选择“隐藏格式”按钮后，它显示实际上根本没有空格。该字符仅在显示器上显示不正确。我尝试了一些事情，比如在文件创建过程中更改字体以及使用REPLACE功能无济于事。这不是一个孤立的事件I found this documentation on the problem, unfortunately it does not pertain to VBA。寻找有关如何解决问题的一些想法。

Sub WordReplaceSentence()

MsgBox "Welcome to the word document automatic modifier", vbInformation + vbOKOnly

MsgBox "Please open the revision file", vbInformation + vbOKOnly

    Dim strfilename1 As String
    Dim fd1 As Office.FileDialog

   ''''''Browsing/Opening the change request'''''''

    Set fd1 = Application.FileDialog(msoFileDialogFilePicker)

   With fd1

      .AllowMultiSelect = False
      .Title = "Open the modified word document."
      .Filters.Clear
      .Filters.Add "Word 2010", "*.docx"
      .Filters.Add "All Files", "*.*"

      If .Show = True Then
        strfilename1 = .SelectedItems(1) 'replace txtFileName with your textbox
      Else
      Exit Sub
      End If
   End With



MsgBox "Open the orginal document", vbInformation + vbOKOnly


Dim strfilename2 As String

    Dim fd2 As Office.FileDialog

    Set fd2 = Application.FileDialog(msoFileDialogFilePicker)

   With fd2

      .AllowMultiSelect = False
      .Title = "Please select the original file."
      .Filters.Clear
      .Filters.Add "Word 2010", "*.docx"
      .Filters.Add "All Files", "*.*"

      If .Show = True Then
        strfilename2 = .SelectedItems(1) 'replace txtFileName with your textbox
      Else
      Exit Sub
      End If
   End With


MsgBox "Please enter the file name with which you want to store the new updated file", vbInformation + vbOKOnly


''''''''''''''''''Asking user to input name to the new revised document'''''''''''''''''''''''''''''''''''''

    Dim strfilename3 As String

    Dim fd3 As Office.FileDialog

    Set fd3 = Application.FileDialog(msoFileDialogSaveAs)

   With fd3
      .AllowMultiSelect = False
      .Title = "Please select the name to be given to the new file."
      If .Show = True Then
        strfilename3 = .SelectedItems(1) 'replace txtFileName with your textbox
      Else
      Exit Sub
      End If
   End With



    FileCopy strfilename2, strfilename3

    Set objWordChange = CreateObject("Word.Application")
    Set objWordorig = CreateObject("Word.Application")

    objWordChange.Visible = False
    objWordorig.Visible = False

    Set objDocChange = objWordChange.Documents.Open(strfilename1)
    Set objSelectionChange = objWordChange.Selection
    Set objDocOrig = objWordorig.Documents.Open(strfilename3)
    Set objSelectionOrig = objWordorig.Selection

    Dim rSearch As Range
    Dim dict As Scripting.Dictionary
    Dim i As Long


    'We'll store the sentences here
    Set dict = New Scripting.Dictionary

    Set rSearch = objDocChange.Range
    With rSearch
        .Find.Forward = True
        .Find.Format = True
        .Find.Font.Color = wdColorBlue
        .Find.Execute

        Do While .Find.Found
            'key = revised sentence, item = original sentence
            'if the revised sentence already exists in the dictionary, replace the found word in the entry
            If dict.Exists(.Sentences(1).Text) Then
                dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), Space(2), Space(1))
                dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " ,", ",")
                dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " .", ".")
                dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " '", "'")
                 For Each Key In dict
                        Debug.Print "KEY: " & Key
                        Debug.Print "Item: " & Item
                    Next

            Else
            'if the revised sentence isn't in the dict, then this is the first found word, so add it and replace the word
                dict.Add .Sentences(1).Text, Replace$(Replace$(.Sentences(1).Text, .Text, vbNullString), Space(2), Space(1))
                dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " ,", ",")
                dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " .", ".")
                dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " '", "'")
            End If
            .Find.Execute
        Loop
    End With

    'Loop through all the dictionary entries and find the origial (item) and replace With
    'the revised (key)
    For i = 1 To dict.Count
        Set rSearch = objDocOrig.Range
        With rSearch.Find
            .MatchWholeWord = False
            .MatchCase = False
            .MatchPhrase = True
            .IgnoreSpace = True
            .IgnorePunct = True
            .Wrap = wdFindContinue
            .Text = dict.Items(i - 1)
            .Replacement.Text = dict.Keys(i - 1)
            .Execute Replace:=wdReplaceOne

        End With
        With objDocOrig.Range
            .Font.Name = "Calibri"
        End With
    Next i

objDocChange.Close
objDocOrig.Save
objDocOrig.Close

objWordChange.Quit
objWordorig.Quit

End Sub

如果您需要/想要测试我的代码，则必须创建两个word文档。每个文档都需要一个包含撇号的公共句子（显然）。除了RGB 0,0,225中的原始句子之外，第二个文档还需要一些蓝色字。

Answer 1

找到了我自己的问题的答案。我不得不禁用＆＃34;亚洲文字字体＆＃34;在字体窗格中。这可以通过进入Microsoft语言注册表并禁用各种语言来完成。 Source

显示故障。创建单词文档VBA后撇号后的额外空格

1 个答案: