aus Excel worddokument Bookmarks

Hallo,
nach langer Suche benötige ich dringend eure Hilfe.
Ich habe ein Makro in einem Worddokument, welches die vorhandenen Bookmarks durchläuft:
Dim xRange As Range 'benötigt für Durchlauf der Zeilen im Dokument
Dim xFiled 'As Field 'benötigt für die Felder im Dokument
For Each xRange In ActiveDocument.StoryRanges
For Each xFiled In xRange.Fields
With xFiled
.Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Execute FindText:=SucheNach, ReplaceWith:=ErsetzeDurch, Replace:=2
Selection.Find.Execute FindText:=alterpfad, ReplaceWith:=aktuellerpfad, Replace:=2
.Update
End With
Next
Next
Wenn ich dies aus dem Word-Dokument heraus durchführe funktioniert dies einwandfrei.
Jetzt möchte ich dies jedoch aus meinem Excel-Code heraus ausführen.
Für das Worddokument aus Excel habe ich folgende Deklarationen:
Dim objWordApp As Object, objWDDoc As Object 'benötigt für Öffnen und schliessen von Worddokument
Dim DocWD As Object
Set DocWD = objWDDoc
Was muss ich bitte ändern, damit die Bookmarks des Worddokuments durchlaufen werden?
Besten Dank für eure Hilfe.
Gruss
Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Peter,
dein Programm könnte so aussehen:

Sub Word_Dokument_bearbeiten()
Dim aktuellerpfad As String
Dim alterpfad As String
Dim ErsetzeDurch As String
Dim objWordApp As Object
Dim objWDDoc As Object
Dim pfad As String
Dim SucheNach As String
Dim xRange As Object 'benötigt für Durchlauf der Zeilen im Dokument
Dim xFiled As Object 'benötigt für die Felder im Dokument
pfad = ThisWorkbook.Path & "\"
Set objWordApp = CreateObject("Word.Application")
objWordApp.Visible = True
Set objWDDoc = objWordApp.Documents.Open(Filename:=pfad & "MeinDokument.docx")
For Each xRange In objWDDoc.StoryRanges
For Each xFiled In xRange.Fields
With xFiled
.Select
objWordApp.Selection.Find.ClearFormatting
objWordApp.Selection.Find.Replacement.ClearFormatting
objWordApp.Selection.Find.Execute FindText:=SucheNach, _
ReplaceWith:=ErsetzeDurch, _
Replace:=2
objWordApp.Selection.Find.Execute FindText:=alterpfad, _
ReplaceWith:=aktuellerpfad, _
Replace:=2
.Update
End With
Next xFiled
Next xRange
objWDDoc.Close SaveChanges:=True
objWordApp.Quit
Set objWDDoc = Nothing
End Sub

Um das zu testen müsstest du dein Worddokument (mit Testdaten) hochladen.
Viele Grüße
Dieter

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread