VBA Selection.PasteAndFormat添加換行符

Question

我有一個VBA腳本，它可以在Excel中找到一個命名的單元格，並根據Word中的標識符將其粘貼到Word中。我使用RegEx來查找標識符。

我遇到的問題是，只要它粘貼值（正確）它「按Enter」，以便它進入下一行。它不應該。

下面是腳本：

Dim objWord, objWordDoc, RegEx, objExcel, objWorkbook, content, texts, text, Text_Name 

Set RegEx = CreateObject("VBScript.RegExp") 

Set objWord = CreateObject("Word.Application") 
Set objExcel = CreateObject("Excel.Application") 

Set objWordDoc = objWord.Documents.Open("D:\Performance Review Template Rev1.docx", False, True) 
Set objWorkbook = objExcel.Workbooks.Open("D:\Template Rev1.xlsm", False, True) 

'The entire content of the Word Document 
Set content = objWord.ActiveDocument.Content 

'The Regular Expression in terms of finding the short code within the document 
'Explanation 
'----------- 
'\[# == Escaped [# characters to indicate that the start of the search needs to be an [# 
'(.*?) == The forward seach in a non greedy way that is also the return group 
'\] == Escaped ] character that signals the end of the search term 
RegEx.Pattern = "\[#(.*?)\]" 
RegEx.Global = True 

Set texts = RegEx.Execute(content) 
Dim Found 

For Each text In texts 
    Set content = objWord.ActiveDocument.Content 
    'Find the TextName that is in the short code. The Submatches property returns 
    'the value of the inner return group, whereas the .Value property only returns 
    'the value of the short code with the [!xxx] added 
    Text_Name = text.submatches(0) 
    Dim xName, xText 
    Found = False 
    'Search for the text through all the Named Cells in the Excel file 

    objExcel.Range(Text_Name).Copy 

    With content.Find 
     .MatchWholeWord = True 
     .Text = text.Value 
     .Execute 
     If .Found = True Then 
      Found = True 
      content.PasteAndFormat 20 
     End If 
    End With 

    If Found = False Then 
     MsgBox "Did not find Named Cell!" 
    End If 

    With content.Find 
     .Text = text.Value 
     .Execute 
     If .Found = True Then 
      objWord.Selection.Range.Delete 
     End If 
    End With  
Next 

MsgBox "Completed named cells" 

objWord.ActiveDocument.Close 
objWord.Application.Quit 

objExcel.ActiveWorkbook.Close 
objExcel.Application.Quit 

像往常一樣，任何幫助總是讚賞。

Answer 1

這似乎是複製功能的標準行爲（手動執行相同的結果）。 建議的解決方案可能是使用直接複製內容而不是使用複製&粘貼。

格式也從目標文件中保存。 這裏測試代碼（標有%%%%變化）：

Dim objWord, objWordDoc, RegEx, objExcel, objWorkbook, content, texts, text, Text_Name, copiedText ' %%%% Added variable 

Set RegEx = CreateObject("VBScript.RegExp") 

Set objWord = CreateObject("Word.Application") 
Set objExcel = CreateObject("Excel.Application") 

Set objWordDoc = objWord.Documents.Open("D:\Performance Review Template Rev1.docx", False, True) 
Set objWorkbook = objExcel.Workbooks.Open("D:\Template Rev1.xlsm", False, True) 

'The entire content of the Word Document 
Set content = objWord.ActiveDocument.content 

'The Regular Expression in terms of finding the short code within the document 
'Explanation 
'----------- 
'\[# == Escaped [# characters to indicate that the start of the search needs to be an [# 
'(.*?) == The forward seach in a non greedy way that is also the return group 
'\] == Escaped ] character that signals the end of the search term 
RegEx.Pattern = "\[#(.*?)\]" 
RegEx.Global = True 

Set texts = RegEx.Execute(content) 
Dim Found 

For Each text In texts 
    Set content = objWord.ActiveDocument.content 
    'Find the TextName that is in the short code. The Submatches property returns 
    'the value of the inner return group, whereas the .Value property only returns 
    'the value of the short code with the [!xxx] added 
    Text_Name = text.submatches(0) 
    Dim xName, xText 
    Found = False 
    'Search for the text through all the Named Cells in the Excel file 

    copiedText = objExcel.Range(Text_Name).text ' %%%% 
    ' %%%% Instead of objExcel.Range(Text_Name).Copy 

    With content.Find 
     .MatchWholeWord = True 
     .text = text.Value 
     .Execute 
     If .Found = True Then 
      Found = True 
      .Parent.text = copiedText ' %%%% 
      ' %%%% Instead of content.PasteAndFormat 20 
     End If 
    End With 

    If Found = False Then 
     MsgBox "Did not find Named Cell!" 
    End If 

    With content.Find 
     .text = text.Value 
     .Execute 
     If .Found = True Then 
      objWord.Selection.Range.Delete 
     End If 
    End With 
Next 

MsgBox "Completed named cells" 

objWord.ActiveDocument.Close 
objWord.Application.Quit 

objExcel.ActiveWorkbook.Close 
objExcel.Application.Quit