0
我有这个VBA代码需要两个文档（一个原始文档和一个带有蓝色文本的修订版文档添加），并创建第三个文档与修订。它主要工作，但是当第三个副本被创建，撇号后有额外的空间。但它实际上并不是一个额外的空间。在Word中选择“隐藏格式”按钮后，它显示根本没有空间。该字符只是错误地显示在显示器上。我已经尝试了一些东西，例如在创建文件时更改字体，并使用REPLACE函数无济于事。这不是一个孤立的事件，I found this documentation on the problem, unfortunately it does not pertain to VBA。寻找如何解决问题的一些想法。显示故障。 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中的原始语句之外，第二个文档需要几个蓝色字。