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