M
MSCom
Neuer Benutzer
Threadstarter
- Dabei seit
- 20.09.2016
- Beiträge
- 1
Hallo liebe Forums-User!
Ich versuche einen Makro zu erstellen, der in einem längeren Dokument mehrere beliebige unterschiedliche Webadressen automatisch in Hyperlinks umwandelt.
Problematisch finde ich es, den richtigen Code dafür zu finden.
Ich habe in einem uralten Thread von 2011 in einem anderen Forum* folgenden Code gefunden:
*Link:
Makro Hyperlink erstellen - - - - - - - - - Office-Loesung.de.
Option Explicit
Sub MakeHyperlink()
Dim oRange As Range
Set oRange = ActiveDocument.Range
With oRange.Find
.Text = "http://*.*."
.Wrap = wdFindContinue
.MatchWildcards = True
While .Execute
.Parent.Select
Selection.MoveEnd wdWord, 1
Dim myRange As Range
If Selection.Characters.Last = " " Then
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End - 1)
Else
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End)
End If
If myRange.Hyperlinks.Count = 1 Then Exit Sub
Dim hLink As String
hLink = myRange.Text
ActiveDocument.Hyperlinks.Add Anchor:=myRange, Address:= _
hLink, SubAddress:="", ScreenTip:="", TextToDisplay:=hLink
Selection.MoveRight wdCharacter, 1
oRange.SetRange Start:=Selection.Range.Start, _
End:=ActiveDocument.Range.End
Wend
End With
End Sub
Leider funktioniert dieser Code nicht (mehr) [zumindest bei mir] und nach dem Inhalt des alten Forumsthreads zu urteilen, soll er auch nur dann Anwendung finden, wenn ein Link markiert wird, während ich will, dass die Funktion von sich aus alle relevanten Stellen findet und in Hyperlinks umwandelt.
Mein "Code" ist dementsprechend nur etwas erweitert bei den Adressen, aber ich weiß nicht, wie ich das so umsetzen kann, wie ich das will.
Sub company_Hyperlinks()
'
' companyMakro
' Inserts hyperlinks
'
Dim oRange As Range
Set oRange = ActiveDocument.Range
With oRange.Find
.Text = "http://*.*."
.Text = "https://*.*."
.Text = "www.*.*"
.Wrap = wdFindContinue
.MatchWildcards = True
While .Execute
.Parent.Select
Selection.MoveEnd wdWord, 1
Dim myRange As Range
If Selection.Characters.Last = " " Then
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End - 1)
Else
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End)
End If
If myRange.Hyperlinks.Count = 1 Then Exit Sub
Dim hLink As String
hLink = myRange.Text
ActiveDocument.Hyperlinks.Add Anchor:=myRange, Address:= _
hLink, SubAddress:="", ScreenTip:="", TextToDisplay:=hLink
Selection.MoveRight wdCharacter, 1
oRange.SetRange Start:=Selection.Range.Start, _
End:=ActiveDocument.Range.End
Wend
End With
End Sub
Ich würde mich über Hilfe natürlich sehr freuen!
Ich versuche einen Makro zu erstellen, der in einem längeren Dokument mehrere beliebige unterschiedliche Webadressen automatisch in Hyperlinks umwandelt.
Problematisch finde ich es, den richtigen Code dafür zu finden.
Ich habe in einem uralten Thread von 2011 in einem anderen Forum* folgenden Code gefunden:
*Link:
Makro Hyperlink erstellen - - - - - - - - - Office-Loesung.de.
Option Explicit
Sub MakeHyperlink()
Dim oRange As Range
Set oRange = ActiveDocument.Range
With oRange.Find
.Text = "http://*.*."
.Wrap = wdFindContinue
.MatchWildcards = True
While .Execute
.Parent.Select
Selection.MoveEnd wdWord, 1
Dim myRange As Range
If Selection.Characters.Last = " " Then
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End - 1)
Else
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End)
End If
If myRange.Hyperlinks.Count = 1 Then Exit Sub
Dim hLink As String
hLink = myRange.Text
ActiveDocument.Hyperlinks.Add Anchor:=myRange, Address:= _
hLink, SubAddress:="", ScreenTip:="", TextToDisplay:=hLink
Selection.MoveRight wdCharacter, 1
oRange.SetRange Start:=Selection.Range.Start, _
End:=ActiveDocument.Range.End
Wend
End With
End Sub
Leider funktioniert dieser Code nicht (mehr) [zumindest bei mir] und nach dem Inhalt des alten Forumsthreads zu urteilen, soll er auch nur dann Anwendung finden, wenn ein Link markiert wird, während ich will, dass die Funktion von sich aus alle relevanten Stellen findet und in Hyperlinks umwandelt.
Mein "Code" ist dementsprechend nur etwas erweitert bei den Adressen, aber ich weiß nicht, wie ich das so umsetzen kann, wie ich das will.
Sub company_Hyperlinks()
'
' companyMakro
' Inserts hyperlinks
'
Dim oRange As Range
Set oRange = ActiveDocument.Range
With oRange.Find
.Text = "http://*.*."
.Text = "https://*.*."
.Text = "www.*.*"
.Wrap = wdFindContinue
.MatchWildcards = True
While .Execute
.Parent.Select
Selection.MoveEnd wdWord, 1
Dim myRange As Range
If Selection.Characters.Last = " " Then
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End - 1)
Else
Set myRange = ActiveDocument.Range(Selection.Range.Start, _
Selection.Range.End)
End If
If myRange.Hyperlinks.Count = 1 Then Exit Sub
Dim hLink As String
hLink = myRange.Text
ActiveDocument.Hyperlinks.Add Anchor:=myRange, Address:= _
hLink, SubAddress:="", ScreenTip:="", TextToDisplay:=hLink
Selection.MoveRight wdCharacter, 1
oRange.SetRange Start:=Selection.Range.Start, _
End:=ActiveDocument.Range.End
Wend
End With
End Sub
Ich würde mich über Hilfe natürlich sehr freuen!