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中的原始語句之外，第二個文檔需要幾個藍色字。