extrahieren Sie den Excel-Tabellenbereich und kopieren Sie in ein neues Word-Dokument

Question

Ich möchte einen Excel-Bereich in ein neues Word-Dokument kopieren. Einige Bereiche, die ich nicht wirklich hier bleiben möchte, damit ich diese bestimmten Zeilen zuerst manuell ausblenden Ich werde mein vb-Programm ausführen und automatisch in ein neues Word-Dokument einfügen.

Ich kopiere jedoch den Bereich und Einfügen in das neue Word-Dokument in einem Bildformat. Ich möchte in ein Wort Tabellenformat einfügen. Aber bitte blieb, dass das Wort Tabellenformat sollte am besten mit der Landschaft A4 Wortformat passen .Wie mache ich das?

Hier ist mein Code:

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

Bitte geben diesem einen Versuch ...

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

Zunächst einmal müssen Sie Standard Kopie auslösen, aber nicht .CopyPicture method:

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

Als nächstes Sie .PasteExcelTable method wie diese auslösen können:

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

Bitte machen Sie einige Tests mit beiden WordFormattin und RTF Parameter. Abhängig von True or False können Sie leicht unterschiedliche Ergebnisse haben. Die vorgeschlagene Lösung wird versuchen, so einzufügen, dass sie dem aktuellen Seitenlayout entspricht. Wenn die Quellentabelle jedoch zu breit oder zu hoch ist, kann sie ohne zusätzliche Anpassungen nicht funktionieren.