Eure Forum hat mir schon sehr häufig bei meinen VBA Problemen geholfen, aber jetzt bin ich auf ein Problem gestoßen, dass ich selbst nicht lösen kann und auf eure Hilfe setze.
Ich habe in Excel ein makro geschrieben, dass mir eine Wordvorlage öffnet, Felder automatisch aus Excel füllt und das Word dann speichert unter neuem Namen.
Soweit funktioniert es.
Nun möchte ich aber in diesem Makro eigentlich gerne haben, dass alle Tabellen in Word in einem Dokument untereinander stehen. Also eigentlich folgende Schritte:
Wordvorlage öffnen
Word automatisch füllen aus Excel
Inhalt dieses Worddokuments kopieren
In neues Work Dokument einfügen (zusa.doc)
Erstes Worddokument speichern.
Neues Workdokument öffnen
Inhalt wieder automatisch füllen aus Excel
Inhalt kopieren und in zusa.doc kopieren.
Bei den Punkte mit Kopieren und zusammenfügen scheitere.
Kann mir jemand helfen?
Hier mein Code:
Sub AlleSchnipselerzeugen()
Dim i As Integer
Dim letztezeile As Integer
'Pfad = Cells(1, 1) 'entweder in A1 den Pfad eingeben oder diese Zeile auskommentieren...
Pfad = "C:\temp\Schnipsel.docx" '...und hier den Pfad eingeben
letztezeile = InputBox("was ist die letzte Zeile mit RedmineNummer?")
Set wdAnw = CreateObject("Word.Application") 'Word-Instanz erzeugen
Set wdDokzusa = wdAnw.documents.Add
wdDokzusa.SaveAs ThisWorkbook.Path & "\" & "zusa" & ".doc"
For i = 2 To letztezeile
On Error Resume Next
Set wdAnw = GetObject(, "Word.Application") 'Bestehende Word-Instanz suchen
Select Case Err.Number
Case 0 'Alles paletti
Case 429 'Es gibt soweit keine Word-Instanz
Err.Clear
Set wdAnw = CreateObject("Word.Application") 'Word-Instanz erzeugen
If Err.Number > 0 Then
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
Case Else 'Unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End Select
On Error GoTo 0
wdAnw.Visible = True 'Instanz sichtbar machen
wdAnw.WindowState = 0
'Je nach dem, ob das Dokument bereits geöffnet ist oder nicht wird verbunden
'bzw. geöffnet. Diese Differenzierung geschieht implizit.
On Error Resume Next
'Set wdDok = wdAnw.Documents.Open(Filename:=Pfad)
Set wdDok = wdAnw.documents.Add(Template:=Pfad)
If Err.Number > 0 Then 'Wenn Arbeitsmappe nicht existiert oder unerwarteter Fehler
BadOrHappyEnd Err.Number, Err.Description
Exit Sub
End If
On Error GoTo 0
'hier kommt das eigentliche Eintragen
wdAnw.activeDocument.FormFields.Item("Redmine").Result = Cells(i, 11)
wdAnw.activeDocument.FormFields.Item("Status").Result = Cells(i, 10)
wdAnw.activeDocument.FormFields.Item("Konfiguration").Result = Cells(i, 7)
wdAnw.activeDocument.FormFields.Item("Tester").Result = Cells(i, 6)
wdAnw.activeDocument.FormFields.Item("Ort").Result = Cells(i, 5)
wdAnw.activeDocument.FormFields.Item("Datum").Result = Cells(i, 4)
wdAnw.activeDocument.FormFields.Item("Auswahl").Result = Cells(i, 8)
'**************Hier meine Versuche des kopierens und zusammenfügen, wobei ich kläglich _
gescheitert bin*******************************************************
' wdAnw.activeDocument.Select
wdAnw.Selection.wholeStory
Selection.Copy
'Selection.wholeStory
'Selection.Copy
' Selection.PasteAndFormat (wdFormatOriginalFormatting)
wdAnw.activeDocument.Content.Insert
'wdAnw.activeDocument.Copy
'wddokuzusa.activeDocument.Paste
' ****************ENDE der VERSUCHE***************************
wdAnw.activeDocument.SaveAs ThisWorkbook.Path & "\" & Cells(i, 11).Value & ".doc"
wdAnw.activeDocument.Close
Next i
BadOrHappyEnd Err.Number, Err.Description
End Sub