- Sub AnschreibenGutachtenNeu()
- Dim strFileName As String
- Dim objWDApp As Object 'Word.Application
- Dim objDocx As Object 'Word.Document
- Dim currentrow As Byte 'Referenzzelle in Excel ( Weiß nicht ob das als Byte Wert Funktioniert )
- 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
- currentrow = ActiveCell.Row
- Application.ScreenUpdating = False
- If objWDApp Is Nothing Then
- 'damit wird verhindert das Word ein zweites Mal
- 'mit CreateObject geöffnet wird
- 'die erstere läst sich sonst aus dem Task nicht entfernen
- 'Bei mehreren Versuchen erreichst du ganz schnell ein OutOfMemory
- Set objWDApp = CreateObject("Word.Application")
- bolWordLiefNicht = True
- End If
- 'Word-Anwendung sichtbar starten
- Set objWDApp = CreateObject("Word.Application")
- objWDApp.Visible = True
- 'Vorlage öffnen - schreibgeschützt
- Set objDocx = objWDApp.Documents.Open(strFileName, ReadOnly:=True)
- 'Werte aus Zellen in Excel an Textmarken im Worddokument einfügen
- If objDocx.Bookmarks.Exists("Aktenzeichen") = True Then
- objDocx.Bookmarks("Aktenzeichen").Range.Text = Cells(currentrow, "G") 'aus Spalte G
- End If
- Application.ScreenUpdating = True
- objDocx.SaveAs ("C:\Users\CG\Documents\Spaces\Bea und Chris\Projekt Makro\ErsterSpeicher.docx")
- End Sub
Please Help Me