Zahlen in Word mit Zahlen aus Excel ersetzen
24.09.2017 06:13:54
fcs
Hallo Robert, hallo Claudia,
ich hatte mich auch schon mit dem Problem beschäfftigt.
Vorraussetzung für korrekte Funktion von Roberts Makro:
Die Zuordnung der Zahlen in der Excelliste ist eindeutig! D.h., neue Zahlen kommen nicht in den alten Zahlen vor, alte nicht in den neuen.
Falls die Zuordnung nicht eindeutig ist, dann muss man einigen Aufwand treiben, um die Ersetzungen korrekt durchzuführen.
Wichtige Anpassung in Roberts Makro:
Es müssen immer die ganzen Wörter (Zahlen) ersetzt werden - also
.MatchWholeWord = True
Weitere Optimierungen:
Variablen für Excel-Objekte als Object deklarieren - dann muss man den Verweis auf die Microsoft Excel x.x Object Library in der Worddatei nicht setzen
Excel-Datei schreibgeschützt öffnen
Excel-Datei ohne speichern wieder schliessen
Excel-Anwendung in der Testphase sichtbar machen
Das Makro speichert man am besten in einem allgemeinen Modul in der Word-Normal.dotm.
Dann ist das Makro jederzeit verfügbar und die Word-Datei bleibt Makrofrei.
Gruß
Franz
Optimiertes Makro:
'Makro in Word
'Erstellt/getestet und Word/Excel 2010 unter Windows Vista
Sub ErsetzenZahlen_aus_Excelliste()
Dim xlApp As Object 'Excel.Application 'geändert fcs
Dim xlWkb As Object 'Excel.Workbook 'geändert fcs
Dim xlWks As Object 'Excel.Worksheet 'geändert fcs
Dim rng As Object ' Excel.Range 'geändert fcs
Dim iCounter As Long 'geändert fcs
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True 'sinnvoll während der Testphase des Makros
Set xlWkb = xlApp.Workbooks.Open(ActiveDocument.Path & "\Zahlen_in_Word_Ersetzen.xlsx", _
ReadOnly:=True) 'Dateiname anpassen - geändert fcs
Set xlWks = xlWkb.Worksheets(1)
Set rng = xlWks.Range("A1").CurrentRegion
For iCounter = 1 To rng.Rows.Count 'Startzeile ggf.anpassen
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = xlWks.Cells(iCounter, 1)
.Replacement.Text = xlWks.Cells(iCounter, 2)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True 'geändert fcs - sehr wichtig!!!
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
xlWkb.Close False 'geändert fcs
xlApp.Quit
Set xlWks = Nothing
Set xlWkb = Nothing
Set xlApp = Nothing
End Sub