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