27.01.2016, 09:53 (Dieser Beitrag wurde zuletzt bearbeitet: 27.01.2016, 10:49 von 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
28.01.2016, 10:05 (Dieser Beitrag wurde zuletzt bearbeitet: 28.01.2016, 10:06 von Rabe.)
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 = TrueThen wsa.Range("A1:B5").Copy .PasteExcelTable False, False, False .TypeParagraph .TypeParagraph EndIf If chk2 = TrueThen wsb.Range("A1:C4").Copy .PasteExcelTable False, False, False .TypeParagraph .TypeParagraph EndIf If chk3 = TrueThen wsc.Range("A1:J31").Copy .PasteExcelTable False, False, False EndIf EndWith
Dann werden auch die Ausschnitte eingefügt!
Hier nochmal der komplette Code:
OptionExplicit
PrivateSub cmdErstellen_Click() Dim appWord AsObject Dim doc AsObject Dim wsa AsObject Dim wsb AsObject Dim wsc AsObject
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 = TrueThen wsa.Range("A1:B5").Copy .PasteExcelTable False, False, False .TypeParagraph .TypeParagraph EndIf If chk2 = TrueThen wsb.Range("A1:C4").Copy .PasteExcelTable False, False, False .TypeParagraph .TypeParagraph EndIf If chk3 = TrueThen wsc.Range("A1:J31").Copy .PasteExcelTable False, False, False EndIf EndWith
EndSub
Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:1 Nutzer sagt Danke an Rabe für diesen Beitrag 28 • Joe
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:1 Nutzer sagt Danke an snb für diesen Beitrag 28 • Joe
28.01.2016, 13:59 (Dieser Beitrag wurde zuletzt bearbeitet: 28.01.2016, 13:59 von 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
(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.
28.01.2016, 14:44 (Dieser Beitrag wurde zuletzt bearbeitet: 28.01.2016, 14:44 von 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
(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.