Excelテーブルの範囲を抽出して新しい単語の文書にコピー

Question

Excel文書の範囲を新しい文書にコピーしたいと思っています。ここに残したくない範囲があります。 、私は私の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

適切なペースト法を行うことにより、録音Wordでマクロ...これに

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に応じて、少し異なる結果が得られます。提案されたソリューションは、現在のページレイアウトに合わせて貼り付けを試みます。しかし、ソーステーブルが広すぎたり、高すぎたりすると、追加調整なしでは機能しません。