Hallo ,
das kann untiges Makro erledigen.
Voraussetzungen:
Es gibt eine Excel-Mappe namens „ersetzungsliste.xlsx“, die im gleichen Ordner gespeichert ist wie das Word-Dokument, in dem die Ersetzungen stattfinden sollen.
In Tabelle1, Spalte A dieser Mappe finden sich ab Zeile 2 die alten Begriffe, in Spalte B ab Zeile 2 die neuen.
Das Makro kommt in ThisDocument des Word-Dokuments.
Sub ersetz_aus_excelliste()
Dim excelinstanz As Object
Dim excelmappe As Object
Dim datei As String
datei = ThisDocument.Path & „\ersetzungsliste.xlsx“
Dim alterbegriff As String, neuerbegriff As String
Dim i As Integer
i = 1
On Error Resume Next
Set excelinstanz = GetObject(, „Excel.Application“) 'wenn das Programm schon läuft
If Err 0 Then
Set excelinstanz = CreateObject(„Excel.application“) ’ wenn nicht, dann erst starten
End If
excelinstanz.Visible = True 'nur zum Testen
On Error GoTo fehler
Set excelmappe = excelinstanz.workbooks.Open(FileName:=datei) 'Mappe öffnen
Do
i = i + 1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = excelmappe.sheets(„Tabelle1“).Cells(i, 1).Value
If .Text = „“ Then Exit Do
.Replacement.Text = excelmappe.sheets(„Tabelle1“).Cells(i, 2).Value
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Loop
MsgBox „fertig“
excelmappe.Close
excelinstanz.Visible = True
excelinstanz.Quit
Set excelmappe = Nothing
Set excelinstanz = Nothing
Exit Sub
fehler:
MsgBox Err.Description & " - " & Err.Number
excelmappe.Close
excelinstanz.Visible = True
excelinstanz.Quit
Set excelmappe = Nothing
Set excelinstanz = Nothing
End Sub