VBA Selection.PasteAndFormat改行を追加する

Question

Excelで名前付きセルを検索し、Wordにある識別子に基づいてWordに貼り付けるVBAスクリプトがあります。私は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