Anzeige(1)

  • Liebe Forenteilnehmer,

    Im Sinne einer respektvollen Forenkultur, werden die Moderatoren künftig noch stärker darauf achten, dass ein freundlicher Umgangston untereinander eingehalten wird. Unpassende Off-Topic Beiträge, Verunglimpfungen oder subtile bzw. direkte Provokationen und Unterstellungen oder abwertende Aussagen gegenüber Nutzern haben hier keinen Platz und werden nicht toleriert.

Ein Makro in Word anpassen

Bloodangel´s Cry

Aktives Mitglied
Ich habe einen langen Text, den ich auf bestimmte Wörter durchsuchen möchte. Da ich keine Lust habe, über 300 Begriffe einzeln mit der Suchfunktion in Word ausfindig zu machen und anschließend zu markieren, habe ich nach einer Lösung gesucht und bin nach etwas Recherche auf ein nützliches Makro gestoßen, das mir die Arbeit so gut wie abnimmt (letzter dargestellter Code auf der Seite):

Mehrere Begriffe in Word-Dokument finden und markieren Office-Loesung.de

Bei dem Makro werden die Begriffe einer geöffneten Excel-Tabelle mit denen in einem Worddokument verglichen. Findet eine Übereinstimmung statt, wird das Wort im Text farblich hervorgehoben.

Das läuft so weit, wie gesagt, ganz gut. Ich habe aber eine Sache, die mich stört:
Der Schreiber hat das Makro scheinbar so erstellt, dass auch Begriffe markiert werden, die das entsprechende Wort aus einer Zelle in Excel enthalten. Das sieht dann z.B. so aus:

Meine Freunde sind ehemalige Kommilitonen. Das ist spannend.

Weil in der Tabelle die Worte „ehe“ und „da“ stehen, werden sie mitmarkiert, auch wenn sie in einem anderen Wort hängen. Das möchte ich aber nicht. Ich möchte eigentlich, dass nur nach ganzen Wörtern gesucht wird, unabhängig von der Groß- und Kleinschreibung.

Ich habe mich nie mit Makros und VBA beschäftigt, kenne mich also überhaupt nicht aus und weiß deshalb nicht, welche Zeilen im Code angepasst werden müssen, damit das Makro so funktioniert, wie ich es mir wünsche. Deshalb frage ich hier nach. Kennt sich jemand damit aus und kann mir sagen, wie der Code angepasst werden müsste, oder mir ggf. sogar einen passenden schreiben?
 

Jusehr

Sehr aktives Mitglied
Eine recht vage Vermutung beim Durchsehen des Codes:

Vielleicht hilft es, wenn man & "*" in folgender Zeile wegläßt:

If UCase(TmpStr) Like AllWord(iWord) & "*" Then
 
G

GrayBear

Gast
Hallo BloodAngel´s Cry,

dieser Code hier funktioniert. Aber Du musst in beiden Anwendungen im Trust-Center die Macro-Funktionen freigegeben haben.

Ich habe nur diese beiden Optionen korrigiert, sonst passt alles. Die Code-Einrückungen wurden leider vom Texteditor des Forums "verschluckt". Das stört die Funktionalität aber nicht. Viel Erfolg. Wenn Du noch Fragen hast, gerne.

.MatchWholeWord = True
.MatchAllWordForms = True

---------------------------------- ab hier kopieren ----------------------------------------

Sub PhrasenMarkieren()
Dim wdRange As Range
' Exceldaten aus offener Arbeitsmappe einlesen
Dim xlApp As Object ' Excel.Application
Dim SuchRange As Object, AktZelle As Object
Set wdRange = ActiveDocument.Range
Set xlApp = GetObject(, "Excel.Application")
Set SuchRange = xlApp.Range("A1:A200") ' 1. Spalte Zeile 1-200
With SuchRange
For Each AktZelle In SuchRange
If AktZelle <> "" Then
' Worddokument durchsuchen und Wörter Rot färben
With wdRange.Find
.Replacement.Font.Color = wdColorRed
.Text = AktZelle
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = True
.Execute Replace:=wdReplaceAll
End With
End If
Next
End With
Set SuchRange = Nothing: Set wdRange = Nothing
End Sub
 

Bloodangel´s Cry

Aktives Mitglied
Hallo BloodAngel´s Cry,

dieser Code hier funktioniert. Aber Du musst in beiden Anwendungen im Trust-Center die Macro-Funktionen freigegeben haben.

Ich habe nur diese beiden Optionen korrigiert, sonst passt alles. Die Code-Einrückungen wurden leider vom Texteditor des Forums "verschluckt". Das stört die Funktionalität aber nicht. Viel Erfolg. Wenn Du noch Fragen hast, gerne.

.MatchWholeWord = True
.MatchAllWordForms = True

---------------------------------- ab hier kopieren ----------------------------------------

Sub PhrasenMarkieren()
Dim wdRange As Range
' Exceldaten aus offener Arbeitsmappe einlesen
Dim xlApp As Object ' Excel.Application
Dim SuchRange As Object, AktZelle As Object
Set wdRange = ActiveDocument.Range
Set xlApp = GetObject(, "Excel.Application")
Set SuchRange = xlApp.Range("A1:A200") ' 1. Spalte Zeile 1-200
With SuchRange
For Each AktZelle In SuchRange
If AktZelle <> "" Then
' Worddokument durchsuchen und Wörter Rot färben
With wdRange.Find
.Replacement.Font.Color = wdColorRed
.Text = AktZelle
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = True
.Execute Replace:=wdReplaceAll
End With
End If
Next
End With
Set SuchRange = Nothing: Set wdRange = Nothing
End Sub
Hallo GrayBear,

vielen Dank für deinen Code! Ich habe ihn soeben ausprobiert, bekomme aber folgende Meldung:


Laufzeitfehler `5610´:
Der Suchtext für ´Alle Wortformen suchen´ darf nur alphabetische Zeichen enthalten.


Ich habe dann einfach etwas herumprobiert und ".MatchAllWordForms" auf "False" gelassen. Soweit scheint es nun zu funktionieren.

Wenn mir noch etwas auffällt, melde ich mich wieder, danke!
 

Anzeige (6)

Ähnliche Themen

Anzeige (6)

Anzeige(8)

Regeln Hilfe Benutzer

Du bist keinem Raum beigetreten.

    Anzeige (2)

    Oben