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