Dim AppWDTextmarken As Object
 
Dim wdApp As Object 'Die Word Application
 
Dim wDoc As Object 'Das Word Dokument bzw. geöffnete Seite
 
On Error Resume Next
 
Set wdApp = GetObject(, "Word.Application")
 
On Error GoTo 0
 
If wdApp Is Nothing Then
 
Set wdApp = CreateObject("Word.Application")
 
wdApp.Visible = True
 
End If
 
wdApp.documents.Add
 
Set wDoc = wdApp.ActiveDocument
 
Set AppWDTextmarken = CreateObject("Word.Application") 'Word als Object starten
 
AppWDTextmarken.Visible = True
 
AppWDTextmarken.documents.Open
Sheets("Einstellungen").Range("C10").Value & "\" &
Sheets("Einstellungen").Range("B10").Value & ".docx"
 
Dim strVar As String
 
Dim TMRange As Range
 
Dim TM As String
 
'Variablen mit Werten füllen
 
strVar = AppWDTextmarken.ActiveDocument.Bookmarks(Sheets( _
  "Prüferstellung").Range("D17").Value).Range.Text
 
TM = Sheets("Prüferstellung").Range("D17").Value
 
'Textmarke füllen und neu setzen
 
If AppWDTextmarken.ActiveDocument.Bookmarks.Exists(TM) Then
 
Set TMRange = AppWDTextmarken.ActiveDocument.Bookmarks(TM).Range
 
'Rangeobjekt einen Wert zuweisen
 
TMRange = strVar
 
'Textmarke mit dem wert setzen
 
wdApp.ActiveDocument.Bookmarks.Add TM, AppWDTextmarken.ActiveDocument.Bookmarks( _
  TM).Range
 
Else
 
Fehlermeldung, wenn es die Textmarke nicht gibt
 
MsgBox "Textmarke konnte nicht gesetzt werden!"'
End If

Dim rng As Range
' AppWDTextmarken.ActiveDocument.Bookmarks(Sheets("Prüferstellung").Range( 
' "D17").Value).Range.Copy
 
AppWDTextmarken.ActiveDocument.Bookmarks(Sheets("Prüferstellung").Range( _
  "D17").Value).Range.Copy
 
rng.Paste
rng.Font.Hidden = False
wdApp.ActiveDocument.Bookmarks.Add Sheets("Prüferstellung").Range("D17").Value, _
  rng