29.11.2022, 12:48
Schönen guten Tag,
Ich möchte Aus Excel heraus mehrere Urkunden drucken
Die Urkundenvorlage ist einer doc gespeichert.
Ich Öffne aus Excel heraus die doc Datei und speicher sie unter neuen Namen ab. Danach fülle die entsprechenden Felder mit den Daten aus Excel. Das funktioniert.
Jetzt sollen die weiteren Urkunden in die selbe Datei gespeichert werden.
Wie das von Hand geht ist mir bewusst. In dem Reiter Einfügen – Objekt – Text aus Datei . Das Funktioniert auch nur wie bekomme ich das Automatisch hin?
Ich finde keine Lösung wie ich diesen Teil des Codes zum laufen bringe.
With oWord
Selection.InsertFile Filename:=Sheets("Einstellungen").Range("B17").Value, _
Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
End With
für den roten Bereich sagt es mir Fehler 438
Könnten sie mir vielleicht einen Tipp geben wie ich das Word dokument ansprechen muss?
Ich würde mich sehr über eine Antwort freuen.
Mit freundlichen Grüßen
Marcel
Ich möchte Aus Excel heraus mehrere Urkunden drucken
Die Urkundenvorlage ist einer doc gespeichert.
Ich Öffne aus Excel heraus die doc Datei und speicher sie unter neuen Namen ab. Danach fülle die entsprechenden Felder mit den Daten aus Excel. Das funktioniert.
Jetzt sollen die weiteren Urkunden in die selbe Datei gespeichert werden.
Wie das von Hand geht ist mir bewusst. In dem Reiter Einfügen – Objekt – Text aus Datei . Das Funktioniert auch nur wie bekomme ich das Automatisch hin?
Code:
Sub ExportToWord()
'Bibliothek aktivieren
Dim wordapp As New Word.Application
Dim doc As Word.Document
Dim Zeile As Long
Dim myRange As Range
Dim oWord As Object, oDoc As Object, oContent As Object
Dim n As Variant
'Word sichtbar machen
wordapp.visible = True
Zeile = Sheets("Endplatzierung").Cells(Rows.Count, 2).End(xlUp).Row
'Word-Datei öffnen
Set doc = wordapp.Documents.Open(Sheets("Einstellungen").Range("B17").Value)
'Word-Datei abspeichern
doc.SaveAs2 ThisWorkbook.Path & "\Urkunden\Jungen\Urkunden Jungen.docx"
Set doc = wordapp.Documents.Open(ThisWorkbook.Path & "\Urkunden\Jungen\Urkunden Jungen.docx")
For Zeile = 5 To Sheets("Endplatzierung").Cells(Rows.Count, 2).End(xlUp).Row
'Word-Datei mit Excel-Daten befüllen
Set oContent = doc.Content
With oContent.Find
.text = "{Jahr}"
.Execute replacewith:=Year(Sheets("Einstellungen").Range("B3").Value), Replace:=2
End With
With oContent.Find
.text = "{Name}"
.Execute replacewith:=Sheets("Endplatzierung").Cells(Zeile, 3).Value & " " & Sheets("Endplatzierung").Cells(Zeile, 2).Value, Replace:=2
End With
With oContent.Find
.text = "{Verein}"
.Execute replacewith:=Sheets("Endplatzierung").Cells(Zeile, 4).Value, Replace:=2
End With
With oContent.Find
.text = "{Klasse}"
.Execute replacewith:="Jungen - Jahrgang " & Sheets("Einstellungen").Range("B7").Value & " und jünger", Replace:=2
End With
With oContent.Find
.text = "{Platz}"
.Execute replacewith:=Sheets("Endplatzierung").Cells(Zeile, 6).Value, Replace:=2
End With
With oContent.Find
.text = "{Ort}"
.Execute replacewith:=Sheets("Einstellungen").Range("B5").Value, Replace:=2
End With
With oContent.Find
.text = "{Datum}"
.Execute replacewith:=Date, Replace:=2
End With
With oContent.Find
.text = "{Leiter}"
.Execute replacewith:=Sheets("Einstellungen").Range("B8").Value, Replace:=2
End With
If Zeile < Sheets("Endplatzierung").Cells(Rows.Count, 2).End(xlUp).Row Then
With oWord
Selection.InsertFile Filename:=Sheets("Einstellungen").Range("B17").Value, _
Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
End With
End If
Next Zeile
'Word-Datei schließen
doc.Close SaveChanges:=True
'Word-Applikation schließen
wordapp.Quit
End SubIch finde keine Lösung wie ich diesen Teil des Codes zum laufen bringe.
With oWord
Selection.InsertFile Filename:=Sheets("Einstellungen").Range("B17").Value, _
Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
End With
für den roten Bereich sagt es mir Fehler 438
Könnten sie mir vielleicht einen Tipp geben wie ich das Word dokument ansprechen muss?
Ich würde mich sehr über eine Antwort freuen.
Mit freundlichen Grüßen
Marcel