VBA: Excel Bereiche kopieren und in Word einfügen
#1
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


Angehängte Dateien
.xlsm   Word_erstellen_Bsp.xlsm (Größe: 25,4 KB / Downloads: 12)
Top
#2
Hi Joe,

(27.01.2016, 09:53)Joe schrieb: 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
[-] Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:
  • Joe
Top
#3
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
Top
#4
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
[-] Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:
  • Joe
Top
#5
Hi,

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

bei
Code:
.Paragraphs.last.PasteExcelTable 0, 0, 0
Top
#6
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
Top
#7
Hi,

(28.01.2016, 13:59)snb schrieb: 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.
Top
#8
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
Top
#9
Hi,

(28.01.2016, 14:44)snb schrieb: 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.
Top
#10
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.
Mit freundlichen Grüßen  :)
Michael
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste