엑셀 테이블 범위를 추출하고 새 워드 문서로 복사

Question

엑셀 범위를 새 워드 문서로 복사하고 싶습니다. 일부는 수동으로 숨기려고합니다. , 나는 내 VB 프로그램을 실행하고 자동으로 새로운 단어 문서에 붙여 넣습니다.

그러나 범위와 복사하여 그림 파일의 새 단어 문서 에 붙여 넣습니다. 에 단어 표 형식을 붙여 넣으려고합니다. 그러나 단어 표 형식은 가로 방향 A4 단어 형식에 가장 잘 맞아야합니다. 어떻게해야합니까? 여기

내 코드입니다 :

'Tbl.CopyPicture Appearance:=xlScreen, Format:=xlPicture 'this line ... 
Tbl.Copy '...replace with this line 

다음,이 같은 .PasteExcelTable method을 트리거 할 수 있습니다 : 모든

Sub gen() 


    Dim tbl0 As Excel.RANGE 
    Dim Tbl As Excel.RANGE 
    Dim tbl2 As Excel.RANGE 

    Dim wordApp As Word.Application 
    Dim myDoc As Word.Document 
    Dim WordTable As Word.Table 
    Dim wb As Workbook 
    Dim ws As Worksheet 

    Set wb = ThisWorkbook 
    Set ws = wb.Worksheets("17-18")    ' Change e.g. sheet9.Name 
    'Optimize Code 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 

'Value1 = Me.TextBox1.Value 
'Value2 = Me.TextBox2.Value 
    'ws.Rows("84:89").EntireRow.Hidden = True 'ADJUST AS APPROPRIATE 

    'Copy Range from Excel 
    'Set tbl0 = ws.RANGE("A78:I83") 
    'Set Tbl = ws.RANGE(Value1, Value2) 
    Set Tbl = ws.RANGE(Selection.Address(ReferenceStyle:=xlA1, _ 
          RowAbsolute:=False, ColumnAbsolute:=False)) 


    ' Set tbl2 = ws.Range("A90:I92") 

    'Create an Instance of MS Word 
    On Error Resume Next 

    'Is MS Word already opened? 
    Set wordApp = GetObject(Class:="Word.Application") 

    'Clear the error between errors 
    Err.Clear 

    'If MS Word is not already open then open MS Word 
    If wordApp Is Nothing Then Set wordApp = CreateObject(Class:="Word.Application") 

    'Handle if the Word Application is not found 
    If Err.Number = 429 Then 
     MsgBox "Microsoft Word could not be found, aborting." 
     GoTo EndRoutine 
    End If 

    On Error GoTo 0 

    'Make MS Word Visible and Active 
    wordApp.Visible = True 
    wordApp.Activate 

    'Create a New Document 
    Set myDoc = wordApp.Documents.Add 

    'Trigger copy separately for each table + paste for each table 

    Tbl.CopyPicture Appearance:=xlScreen, Format:=xlPicture 

    wordApp.Selection.Paste 
    wordApp.Selection.TypeParagraph 

    wordApp.Selection.PageSetup.Orientation = wdOrientLandscape 

    ' resize_all_images_to_page_width myDoc 

EndRoutine: 
    'Optimize Code 
    Application.ScreenUpdating = True 
    Application.EnableEvents = True 

    'Clear The Clipboard 
    Application.CutCopyMode = False 

ws.Rows.EntireRow.Hidden = False 
End Sub 

Answer 1

이 시도주십시오 ...

wordApp.Visible = True 
wordApp.Activate 

'Create a New Document 
Set myDoc = wordApp.Documents.Add 

'Copy the table 
tbl.Range.Copy 

'Paste the table into the document as a table 
myDoc.Range.PasteExcelTable False, True, False 
myDoc.Range.InsertParagraphAfter 
myDoc.PageSetup.Orientation = 1 

Answer 2

첫째, 당신은 표준 복사하지만 .CopyPicture method를 트리거 할 필요가

'wordApp.Selection.Paste 'instead of this line... 
'...try this one... 
wordApp.Selection.PasteExcelTable LinkedToExcel:=False, _ 
          WordFormatting:=True, _ 
          RTF:=True 

WordFormattin 및 RTF 매개 변수 True or False에 따라 약간 다른 결과가 발생할 수 있습니다. 제안 된 솔루션은 현재 페이지 레이아웃에 맞는 방법으로 붙여 넣으려고합니다. 그러나 원본 테이블이 너무 넓거나 너무 높으면 추가 조정 없이는 작동하지 않습니다.