AW: Geschlossene Textmarke - Hyperlink einfügen
09.01.2020 20:52:24
Luschi
Hallo KaEmGe,
der Umgang mit geschlossenen Textmarken in Word ist mit ein paar Tücken verbunden, da diese beim Verändern (Hyperlink draufsetzen u.ä,. in offene Textmarken automatisch umgewandelt werden und so wieder restauriert werden müssen. Dazu muß man sich den Range-Bereich der TM merken.
Ich kann erst mal nur mit 2 Word-Makros dienen, versuche sie Morgen für Excel ausführbar zu _
machen.
''Erstellen einer geschlossenen TM mit Hyperlink
Sub geschlTM_mitHyperLink()
Dim tmRange As Range, tmName As String
tmName = "myTM_01"
Selection.TypeText Text:="xxxxx" ''x-beliebiger Text
'markieren des soeben geschriebenen Textes 'xxxxx'
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
'Erstellen einer geschlossenen Textmarke
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:=tmName
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
''merken des Bereiches der geschl TM
Set tmRange = ActiveDocument.Bookmarks(tmName).Range 'wichtig
''TM markieren
Selection.GoTo What:=wdGoToBookmark, Name:=tmName
With ActiveDocument
'Hyoerlink draufsetzten, dadurch wird es aber eine offene TM!
.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"http://www.herber.de/forum", SubAddress:="", ScreenTip:="", _
TextToDisplay:="www.herber.de"
'geschlossene TM wieder herstellen
.Bookmarks.Add Name:=tmName, Range:=tmRange
End With
Set tmRange = Nothing
End Sub
Sub HypInTMErsetzen()
Dim rg As Range, tmRange As Range, i As Integer, tmName As String, hypText As String
tmName = "myTM_01" 'Name der vorhandenen 'geschlossenen Textmarke
hypText = "www.herber.de" 'TextToDisplay
'gesamten Text markie, um Hyperlink zu suchen
Selection.WholeStory
Set rg = Selection.Range
For i = rg.Hyperlinks.Count To 1 Step -1
If rg.Hyperlinks(i).Range.Text = hypText Then
'gefunden & löschen
rg.Hyperlinks(i).Delete
Exit For
End If
Next i
Selection.HomeKey Unit:=wdStory
rg.GoTo What:=wdGoToBookmark, Name:=tmName
Set tmRange = ActiveDocument.Bookmarks(tmName).Range 'wieder wichtig
'TM markieren
Selection.GoTo What:=wdGoToBookmark, Name:=tmName
With ActiveDocument
'neuen Hyperlink draufsetzen
.Hyperlinks.Add Anchor:=Selection.Range, Address:= _
"https://www.leo.org/englisch-deutsch", SubAddress:="", ScreenTip:="", _
TextToDisplay:="www.leo.org"
'geschlossene TM wieder herstellen
.Bookmarks.Add Name:=tmName, Range:=tmRange
End With
Set tmRange = Nothing
End Sub
Gruß von Luschi
aus klein-Paris