Skip to content

Instantly share code, notes, and snippets.

@grappler
Last active August 29, 2015 14:04
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save grappler/672182d3b324afaebd3c to your computer and use it in GitHub Desktop.
Save grappler/672182d3b324afaebd3c to your computer and use it in GitHub Desktop.
Sub HightlightAkkusativ()
'
' Hightlight Akkusativ
'
'
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("Akkusativ", "bis", "durch", "entlang", "für", "gegen", "ohne", "um", "wider", "herum") ' put list of terms to find here
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow
Loop
End With
Next
End Sub
Sub HightlightDativ()
'
' Hightlight Dativ
'
'
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("Dativ", "ab", "aus", "ausser", "bei", "dank", "entgegen", "entsprechend", "gegenüber", "gemäss", "mit", "nach", "nebst", "samt", "seit", "von", "zu", "zufolge") ' put list of terms to find here
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdBrightGreen
Loop
End With
Next
End Sub
Sub HightlightAkkusativDativ()
'
' Hightlight Akkusativ & Dativ
'
'
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("AkkusativDativ", "an", "auf", "hinauf", "in", "neben", "über", "vor", "zeit", "zwischen") ' put list of terms to find here
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdGray25
Loop
End With
Next
End Sub
Sub HightlightGenitiv()
'
' Hightlight Genetiv
'
'
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("Genitiv", "anlässlich", "ausserhalb", "binnen", "während", "abseits", "ausserhalb", "beiderseits", "diesseits", "inmitten", "innerhalb", "jenseits", "längs", "längsseits", "oberhalb", "seitens", "seiten", "unterhalb", "unweit", "angesichts", "aufgrund", "halber", "infolge", "kraft", "laut") ' put list of terms to find here
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdRed
Loop
End With
Next
End Sub
Sub BigMacro()
'
' Run all Macros
'
'
Selection.WholeStory
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.range.HighlightColorIndex = wdNoHighlight
Call HightlightAkkusativ
Call HightlightDativ
Call HightlightAkkusativDativ
Call HightlightGenitiv
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment