1. Sub Anschreiben()
  5. Dim objWDApp As Object 'Word.Application
  6. Dim objDocx As Object 'Word.Document
  7. Dim currentrow As Byte 'Referenzzelle in Excel
  8. Dim pfad As String
  9. Dim savePfad As String
  11. pfad = ThisWorkbook.Path & "\Makro Vorlagen\Anschreiben.docx" 'Pfad zum öffnen der Vorlage
  12. savePfad = ThisWorkbook.Path & "\Ordner\Makro Output\Anschreiben.docx" 'Pfad zum Speichern
  15. If Dir(pfad) = "" Then
  16. MsgBox "Datei """ & pfad & """ nicht gefunden!"
  17. End If
  20. Application.ScreenUpdating = False
  21. If objWDApp Is Nothing Then
  22. 'damit wird verhindert das Word ein zweites Mal
  23. 'mit CreateObject geöffnet wird
  24. 'die erstere läst sich sonst aus dem Task nicht entfernen
  25. 'Bei mehreren Versuchen erreichst du ganz schnell ein OutOfMemory
  26. Set objWDApp = CreateObject("Word.Application")
  27. bolWordLiefNicht = True
  28. End If
  32. 'Word-Anwendung sichtbar starten
  33. Set objWDApp = CreateObject("Word.Application")
  34. objWDApp.Visible = True
  35. 'Vorlage öffnen - schreibgeschützt
  36. Set objDocx = objWDApp.Documents.Open(pfad)
  38. 'Jetzt würde der Programmteil folgen indem Werte aus Zellen in Excel in Textmarken im Worddokument eingefügt werden ( Diesen Teil lasse ich weg, da er schon funktioniert )
  40. ...
  41. ...
  42. ...
  44. Application.ScreenUpdating = True
  46. objDocx.SaveAs (savePfad)
  50. End Sub