1. Sub AnschreibenGutachtenNeu()
  2. Dim strFileName As String
  3. Dim objWDApp As Object 'Word.Application
  4. Dim objDocx As Object 'Word.Document
  5. Dim xlZelle As Range 'Referenzzelle in Excel
  6. strFileName = "C:\Users\CG\Documents\Spaces\Bea und Chris\Projekt Makro\tester.docx"
  7. If Dir(strFileName) = "" Then
  8. MsgBox "Datei """ & strFileName & """ nicht gefunden!"
  9. Exit Sub
  10. End If
  11. 'Excel-Referenzzelle für Auftrag setzen
  12. ActiveCell.SpecialCells(xlLastCell).Select
  13. With ActiveSheet
  14. Set xlZelle = .Cells(ActiveCell.Row, 1) ' Zelle in aktiver Zeile, Spalte A
  15. End With
  16. Application.ScreenUpdating = False
  17. 'Word-Anwendung sichtbar starten
  18. Set objWDApp = CreateObject("Word.Application")
  19. objWDApp.Visible = True
  20. 'Vorlage öffnen - schreibgeschützt
  21. Set objDocx = objWDApp.Documents.Open(strFileName, ReadOnly:=False)
  22. 'Werte aus Zellen in Excel an Textmarken im Worddokument einfügen
  23. objDocx.Bookmarks("Aktenzeichen").Range.Text = xlZelle.Offset(0, 6).Text 'aus Spalte G funktioniert nicht
  24. objDocx.Bookmarks("Anrede").Range.Text = xlZelle.Offset(0, 4).Text 'aus Spalte E funktioniert nicht
  25. objDocx.Bookmarks("Ansprechpartner").Range.Text = xlZelle.Offset(0, 5).Text 'aus Spalte F funktioniert nicht
  26. objDocx.Bookmarks("Aktenzeichen").Range.Text = "Hallo" 'Funktioniert komischer weise
  27. 'Hier müsste dann noch irgendwie die Speicherung erfolgen
  28. Application.ScreenUpdating = True
  29. End Sub