Ersetzungen funktionieren nur zum Teil

[Steffl]

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?

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

[schauan]

Hallo Stefan,

hast Du es mal mit einem Replace-Parameter wie bei den anderen versucht?

[Steffl]

Hallo André,

ich werde das mal im Januar testen, ich habe kommende Woche Urlaub :17:

[Steffl]

Hallo André,

danke, dein Tipp war die Lösung, es funktioniert wie gewünscht.

Gruß Stefan

[cweimer]

Hallo André,

danke, dein Tipp war die Lösung, es funktioniert wie gewünscht.

Gruß Stefan

hat mir auch geholfen!