VBA: Excel Bereiche kopieren und in Word einfügen

[Joe]

Guten Tag Mitleser und Helfer,

ich habe eine Excel Datei mit mehreren Tabellenblättern und unterschiedlichen Bereichen. Die Bereiche möchte ich gern in eine Word Datei kopieren.
Welche Bereiche kopiert werden soll, kann man mittels Checkboxen in einer UserForm auswählen.
Ich habe ein Code im Internet gefunden und den ein wenig umgeschrieben. Der klappt überhaupt nicht und den verstehe ich nicht komplett.
Wie kann man den Code eleganter gestalten, sodass er einwandfrei funktioniert?

Mit freundlichen Grüßen

Joe

Ps: Beispieldatei ist angehängt

Code:

Dim appWord As Object
Dim doc As Object
Dim wsa As Object
Dim wsb As Object
Dim wsc As Object


Set appWord = CreateObject("Word.Application")
'Set doc = appWord.Documents.Add("T:\Vorlage1.docx") '*** verwendet Datei nur als Vorlage ***  !!!findet die Datei nicht
'Set doc = appWord.Documents.Open("D:\Test-Rubrik.doc") '*** öffnet die Datei selbst ***
appWord.Visible = True

 Set wsa = ThisWorkbook.Worksheets("Tabelle1")
 Set wsb = ThisWorkbook.Worksheets("Tabelle2")
 Set wsc = ThisWorkbook.Worksheets("Tabelle2")
 
   With doc.Application.Selection                    'Verstehe diesen Schritt nicht komplett
       If chk1 = True Then wsa.Range("A1:B5").Copy
        .PasteExcelTable False, False, False        
        .TypeParagraph
        .TypeParagraph
       If chk2 = True Then wsb.Range("A1:C4").Copy
        .PasteExcelTable False, False, False
        .TypeParagraph
        .TypeParagraph
       If chk3 = True Then wsc.Range("A1:J31").Copy
        .PasteExcelTable False, False, False
    End With

[Rabe]

Hi Joe,

Ich habe ein Code im Internet gefunden und den ein wenig umgeschrieben. Der klappt überhaupt nicht und den verstehe ich nicht komplett.
Wie kann man den Code eleganter gestalten, sodass er einwandfrei funktioniert?

Es muß eine Worddatei geöffnet werden, nicht nur die Word-Application. Die erste "appWord.Documents" öffnet bei mir eine vorhandene Vorlage. Die Datei wird also gefunden, wenn sie vorhanden ist.

Vor allem würde ich die Checkbox-Abfrage so machen:

   With doc.Application.Selection

     If chk1 = True Then

        wsa.Range("A1:B5").Copy

        .PasteExcelTable False, False, False

        .TypeParagraph

        .TypeParagraph

     End If

     If chk2 = True Then

        wsb.Range("A1:C4").Copy

        .PasteExcelTable False, False, False

        .TypeParagraph

        .TypeParagraph

     End If

     If chk3 = True Then

        wsc.Range("A1:J31").Copy

        .PasteExcelTable False, False, False

     End If

  End With

Dann werden auch die Ausschnitte eingefügt!

Hier nochmal der komplette Code:

Option Explicit



Private Sub cmdErstellen_Click()

  Dim appWord As Object

  Dim doc As Object

  Dim wsa As Object

  Dim wsb As Object

  Dim wsc As Object

  

  

  Set appWord = CreateObject("Word.Application")

  Set doc = appWord.Documents.Add("C:\temp\Vorlage1.docx") '*** verwendet Datei nur als Vorlage *** 

  'Set doc = appWord.Documents.Open("D:\Test-Rubrik.doc") '*** öffnet die Datei selbst *** 

  appWord.Visible = True

  

  Set wsa = ThisWorkbook.Worksheets("Tabelle1")

  Set wsb = ThisWorkbook.Worksheets("Tabelle2")

  Set wsc = ThisWorkbook.Worksheets("Tabelle3")      'hier war noch die falsche Tabelle (2) genannt 

  

  With doc.Application.Selection

     If chk1 = True Then

        wsa.Range("A1:B5").Copy

        .PasteExcelTable False, False, False

        .TypeParagraph

        .TypeParagraph

     End If

     If chk2 = True Then

        wsb.Range("A1:C4").Copy

        .PasteExcelTable False, False, False

        .TypeParagraph

        .TypeParagraph

     End If

     If chk3 = True Then

        wsc.Range("A1:J31").Copy

        .PasteExcelTable False, False, False

     End If

  End With

  

  

End Sub

[Joe]

Hey Ralf,

Danke!
Jetzt funktioniert es auch bei mir,
manchmal sind es immer diese Kleinigkeiten die einem großen Ärger bereiten können. *grins*

Sollte ich noch Fragen haben, lass ich von mir hören.

Schöne Grüße

Joe

[snb]

Code:

Private Sub cmdErstellen_Click()
  with getobject("C:\temp\Vorlage1.docx")
     if chk1 then
         thisworkbook.sheets("Tabelle1").Range("A1:B5").Copy
         .paragraphs.last.PasteExcelTable 0,0,0
         .content.insertafter string(3,vbcr)
     end if 
     If chk2 Then
         thisworkbook.sheets("Tabelle2").Range("A1:C4").Copy
         .paragraphs.last.PasteExcelTable 0, 0, 0
         .content.insertafter string(3,vbcr)
     End If
     If chk3 Then
         thisworkbook.sheets("Tabelle3").Range("A1:J31").Copy
         .paragraphs.last.PasteExcelTable 0, 0, 0
     End If
  End With
End Sub

[Rabe]

Hi,

da wird auch nur die Word-Instanz geöffnet und nicht die Datei => Fehler 438

bei

Code:

.Paragraphs.last.PasteExcelTable 0, 0, 0

[snb]

Du irrst dich: die Fehler hat eine andere Ursprung.
Getobject(Dateiname) öffnet immer(!) die Datei.
Das wäre anders bei Getobject(,"Word.Application")

Code:

Private Sub cmdErstellen_Click()
  with getobject("C:\temp\Vorlage1.docx")
     if chk1 then
         thisworkbook.sheets("Tabelle1").Range("A1:B5").Copy
         .paragraphs.last.Range.PasteExcelTable 0,0,0
         .content.insertafter string(3,vbcr)
     end if 
     If chk2 Then
         thisworkbook.sheets("Tabelle2").Range("A1:C4").Copy
         .paragraphs.last.Range.PasteExcelTable 0, 0, 0
         .content.insertafter string(3,vbcr)
     End If
     If chk3 Then
         thisworkbook.sheets("Tabelle3").Range("A1:J31").Copy
         .paragraphs.last.Range.PasteExcelTable 0, 0, 0
     End If
  End With
End Sub

[Rabe]

Hi,

Du irrst dich: die Fehler hat eine andere Ursprung.
Getobject(Dateiname) öffnet immer(!) die Datei.

Du hast recht, die Word-Instanz wird nicht geöffnet, aber bei mir arbeitet dein zweites Makro nicht korrekt. Es wird der zu kopierende Bereich in die Zwischenablage kopiert (laufender Rahmen um Bereich), aber da Word nicht geöffnet ist, geht nichts weiter.

Beim ersten kam der Fehler 438 bei

Code:

.Paragraphs.last.PasteExcelTable 0, 0, 0

und Word wurde auch nicht geöffnet.

[snb]

Word ist geöffnet, doch nicht sichtbar (das sind unterschiedene Sachen). Deswegen läuft es ganz geschwindig.

Code:

Private Sub cmdErstellen_Click()
 with getobject("C:\temp\Vorlage1.docx")
    if chk1 then
        thisworkbook.sheets("Tabelle1").Range("A1:B5").Copy
        .paragraphs.last.Range.PasteExcelTable 0,0,0
        .content.insertafter string(3,vbcr)
    end if
    If chk2 Then
        thisworkbook.sheets("Tabelle2").Range("A1:C4").Copy
        .paragraphs.last.Range.PasteExcelTable 0, 0, 0
        .content.insertafter string(3,vbcr)
    End If
    If chk3 Then
        thisworkbook.sheets("Tabelle3").Range("A1:J31").Copy
        .paragraphs.last.Range.PasteExcelTable 0, 0, 0
    End If
    .windows(1).visible=true
 End With
End Sub

[Rabe]

Hi,

Word ist geöffnet, doch nicht sichtbar.

aaah, ok, dann tut es also, ich erkenne es nur nicht, da Word nicht sichtbar ist.
Dann kann man die Word-Datei leider nicht abspeichern, insofern sollte sie schon angezeigt werden.

Aber Du hast recht, prinzipiell ist das besser so. Wenn dann in dem Makro auch gleich das abspeichern und schließen integriert ist, dann geht das alles fix.

[Zwergel]

Hi Ralf,

also bei mir passiert genau das was im Code von snb steht:

Zuerst ohne sichtbares Word die Verarbeitung der Daten, sprich kopieren, danach am Ende des Codes

PHP-Code:

.windows(1).visible=true 


Wordfenster wird sichtbar geschaltet. Dann kann auch manuell gespeichert werden oder eben der Code muß ergänzt werden.