21.12.2018, 09:15
Hallo,
ich erstelle aus Excel heraus Worddokumente, indem ich eine Vorlage aufrufe, mehrere Platzhalter ersetzen lasse und danach das Dokument unter einen anderen Namen abspeichern. Leider funktioniert das mit den Platzhaltern nicht vollständig. Die letzten zwei werden nicht ersetzt. Was mache ich falsch?
ich erstelle aus Excel heraus Worddokumente, indem ich eine Vorlage aufrufe, mehrere Platzhalter ersetzen lasse und danach das Dokument unter einen anderen Namen abspeichern. Leider funktioniert das mit den Platzhaltern nicht vollständig. Die letzten zwei werden nicht ersetzt. Was mache ich falsch?
Code:
Sub prcSchreibenerstellen(vntAnlage As Variant)
'die Schreiben im Word erstellen
'Variablendeklaration
Dim objWord As Object, objDoc As Object, objText As Object
'Verweis auf Word
Set objWord = CreateObject("Word.Application")
'das Vorlagenschreiben öffnen
Set objDoc = objWord.documents.Open(ActiveWorkbook.Path & "\Vorlage_Kostenbescheid_Ueberwachung.docx")
Set objText = objDoc.StoryRanges(1)
'ersaetzen der Platzhaltern mit den Eintragungen aus der Userform
objText.Find.Execute findtext:=">>Kosten<<", replacewith:=Format(vntAnlage(17, 1), "#,##0.00 €"), Replace:=2
objText.Find.Execute findtext:=">>Jahr<<", replacewith:=vntAnlage(1, 1), Replace:=2
objText.Find.Execute findtext:=">>Start<<", replacewith:=Format(vntAnlage(2, 1), "DD.MM.YYYY"), Replace:=2
objText.Find.Execute findtext:=">>Ende<<", replacewith:=Format(vntAnlage(3, 1), "DD.MM.YYYY"), Replace:=2
objText.Find.Execute findtext:=">>Datum<<", replacewith:=Date, Replace:=2
With Kostenerhebung
objText.Find.Execute findtext:=">>Telefon<<", replacewith:=.Telefon.Text, Replace:=2
objText.Find.Execute findtext:=">>Name<<", replacewith:=.BeName.Text, Replace:=2
objText.Find.Execute findtext:=">>E-Mail<<", replacewith:=.EMail.Text, Replace:=2
objText.Find.Execute findtext:=">>Unterzeichner<<", replacewith:=.Unterzeichner.Text, Replace:=2
objText.Find.Execute findtext:=">>Amtsbezeichnung<<", replacewith:=.Amtsbezeichnung.Text, Replace:=2
objText.Find.Execute findtext:=">>Unserzeichen<<", replacewith:=.Unserzeichen.Text, Replace:=2
objText.Find.Execute findtext:=">>Gerichtsstand<<", replacewith:=.Gerichtsort.Text, Replace:=2
End With
objText.Find.Execute findtext:=">>Bezeichnung<<", replacewith:=vntAnlage(12, 1)
objText.Find.Execute findtext:=">>Adressat<<", replacewith:=vntAnlage(5, 1) & _
"^p" & vntAnlage(6, 1) & " " & vntAnlage(7, 1) & "^p" & vntAnlage(9, 1) & _
" " & vntAnlage(10, 1)
'das Dokument unter dem Namen der Kommune abspreichern
objDoc.SaveAs ThisWorkbook.Path & "\Dokumente\" & Replace(Replace(vntAnlage(5, 1), "/", "."), ".", " ")
'die Vorlage ohne zu speichern schließen
objDoc.Close False
objWord.Quit
Set objText = Nothing
Set objDoc = Nothing
Set objWord = Nothing
End Sub