Selection = Hyperlink!

In einer Zelle, oder einem Zellenbereich, steht z. B. "C:\Temp\Test.pdf". Alle mit der Maus markierten Zellinhalte sollen in Hyperlinks umgewandelt werden. Code unten noch etwas angepasst.

Selection = Hyperlink...

Code:
Option Explicit
Public Sub Link()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column), _
Address:= _
Cells(rngRange.Row, rngRange.Column), _
TextToDisplay:= _
Mid(Cells(rngRange.Row, rngRange.Column), _
InStrRev _
(Cells(rngRange.Row, rngRange.Column), "\", -1) + 1)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub
Public Sub Link_1()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column).Offset(0, 1), _
Address:= _
Cells(rngRange.Row, rngRange.Column), _
TextToDisplay:= _
Mid(Cells(rngRange.Row, rngRange.Column), _
InStrRev _
(Cells(rngRange.Row, rngRange.Column), "\", -1) + 1)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub
Public Sub Link_2()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column), _
Address:= _
Cells(rngRange.Row, rngRange.Column)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub
Public Sub Link_3()
Dim rngRange As Range
For Each rngRange In Selection
If Dir(rngRange.Text) <> "" Then
ActiveSheet.Hyperlinks.Add _
Anchor:= _
Cells(rngRange.Row, rngRange.Column).Offset(0, 1), _
Address:= _
Cells(rngRange.Row, rngRange.Column)
Else
rngRange.Font.ColorIndex = 3
End If
Next rngRange
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...