Sub AnkerSetzen()
'REM Beginn einer 6er-Gruppe um Lesezeichen
'Label um nach Suche/Recherche schnell wieder an den Ausgangspunkt zurückzukommen
'Der Label soll optisch sichtbar sein, nicht wie "Bookamrks" quasi unsichtbar
'Ich hoffe, dass Mixyzetpetelka nicht im Text vorkommt.
AnkerKappen
Selection.TypeText ("MXYZPTLK")
'SendKeys ("MXYZPTLK")
End Sub
Sub AnkerKappen()
'2/6 Mich kotzt diese Notwehr an weil ich nur so einen alten Anker wegbekomme um
'einen neuen eindeutig und unzweifelhaft zu setzen.
'SendKeys ist zu langsam um damit eine Lösung zu erreichen.
MarkeSetzen
AnkerLichten
MarkeLöschen
End Sub
Sub AnkerLichten()
'3/6 Sollte man diesen Label mittels AutoClose löschen..?
AnkerSuchen
If Selection = "MXYZPTLK" Then Selection = ""
End Sub
Sub AnkerSuchen()
'4/6 Weil als eigene Funktion erwünscht...
Suchen "MXYZPTLK"
End Sub
Public Sub MarkeSetzen()
'5/6 Setzt eine verborgene Textmarke an der Eingabemarke
'Dieses Funktions-Doppel ist nur für Verwendung innerhalb von Makros geplant!
If ActiveDocument.Bookmarks.Exists("MXYZPTLK") = True Then Exit Sub
'Wir verzichten auf eine Msg-Box.
'WIEDER WÄRE EIN LÖSCHEN MITTELS LSÖCHMAKRO SINNLOS
'DA DAS WESENTLICHE, DIE CURSORPOSITION, VERLOREN GINGE!!!
''Selection.Bookmarks.Add "Lesezeichen", Selection.Range
''Selection.Move wdStory, 1
Selection.Bookmarks.Add "MXYZPTLK"
'On Error ist bei mehr als einer zu übergehenden Zeile (wie ursprünglich) blöd.
End Sub
Public Sub MarkeLöschen()
'6/6 Positioniert die Eingabemarke an der Textmarke
'Dieses Funktions-Doppel ist nur für Verwendung innerhalb von Makros geplant!
If ActiveDocument.Bookmarks.Exists("MXYZPTLK") = True Then
'Purer pessimismus. Sollte innerhalb Makros nie passieren.
With ActiveDocument.Bookmarks("MXYZPTLK")
.Select
.Delete
End With
End If
'REM ENTE der 6er-Gruppe um Lesezeichen
End Sub
'-----
Public Sub Suchen(Nach As String)
BausteinSuchen Nach, True
End Sub
Public Sub BausteinSuchen(Nach As String, Richtung As Boolean)
Dim Tekst As String
Dim Wohin As Boolean
Dim Umbruch As Byte
Dim TextFormat As Boolean
Dim GrossKlein As Boolean
Dim GanzesWort As Boolean
Dim Joker As Boolean
Dim Ähnlich As Boolean
Dim AlleFormen As Boolean
If ExistiertDokument = False Then Exit Sub
With Selection.Find
Tekst = .Text
Wohin = .Forward
Umbruch = .Wrap
TextFormat = .Format
GrossKlein = .MatchCase
GanzesWort = .MatchWholeWord
Joker = .MatchWildcards
Ähnlich = .MatchSoundsLike
AlleFormen = .MatchAllWordForms
.ClearFormatting
.Text = Nach
.Forward = Richtung
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
.Text = Tekst
.Forward = Wohin
.Wrap = Umbruch
.Format = TextFormat
.MatchCase = GrossKlein
.MatchWholeWord = GanzesWort
.MatchWildcards = Joker
.MatchSoundsLike = Ähnlich
.MatchAllWordForms = AlleFormen
End With
End Sub