22.07.2010

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

Keine Kommentare:

Kommentar veröffentlichen

Word - Kontrollkästchen (Formularsteuerelement) auslesen...

Aus allen Worddateien sollen die Kontrollkästchen (Formularsteuerelement) ausgelesen werden - Haken gesetzt oder nicht. Auch ein Textfeld (F...