|
Tipp 0082
|
Hyperlinks - allgemein -
|
|
|
Autor/Einsender: Datum: |
|
Angie 19.06.2001 |
|
Entwicklungsumgebung: |
|
Excel 97 |
|
|
Anhand der folgenden kleinen Beispielen wird u.a. gezeigt, wie es per VBA möglich ist,
alle Hyperlinks, die sich auf einem Tabellenblatt befinden, zu markieren, zu deaktivieren
und die jeweilige Zell-Adresse zu ermitteln.
|
Hinweis
|
Folgende Makros beziehen sich nur auf Hyperlinks, die über das Menü Einfügen / Hyperlink...
eingefügt wurden.
|
|
|
Option Explicit
'---- Hyperlink in Zelle A1 einfügen ------------------------
Sub AddHyperlinkToCell()
With ActiveSheet
.Range("A1").Clear
.Hyperlinks.Add Anchor:=.Range("A1"), _
Address:="http://www.vb-fun.de/", _
TextToDisplay:="VB-fun-Startseite"
End With
End Sub
'---- Zell-Adressen der Zellen mit Hyperlinks ermitteln -----
Sub GetCellsWithHyperlinks()
Dim hypLink As Hyperlink
For Each hypLink In ActiveSheet.Hyperlinks
MsgBox hypLink.Range.Value & " in Zelle " & _
hypLink.Range.Address, vbOKOnly, Title:="Hyperlink..."
Next hypLink
End Sub
'---- Alle Hyperlinks auf dem Tabellenblatt selektieren -----
Sub SelectAllHyperlinks()
Dim hypLink As Hyperlink
Dim nCnt As Integer
Dim rngLinks As Range
nCnt = 1
For Each hypLink In ActiveSheet.Hyperlinks
If nCnt = 1 Then
Set rngLinks = hypLink.Range
nCnt = 0
Else
Set rngLinks = Application.Union(rngLinks, hypLink.Range)
End If
Next hypLink
If Not rngLinks Is Nothing Then
rngLinks.Select
End If
Set rngLinks = Nothing
End Sub
'---- Alle Hyperlinks auf dem Tabellenblatt deaktivieren ----
Sub DeactivateAllHyperlinks()
Dim hypLink As Hyperlink
For Each hypLink In ActiveSheet.Hyperlinks
hypLink.Delete 'Hyperlink deaktivieren
'hypLink.Range.Clear 'Hyperlink löschen
'(Formatierung wird auch gelöscht)
'hypLink.Range = "" 'Hyperlink löschen
'(Zell-Formatierung bleibt erhalten)
Next hypLink
End Sub
'---- Alle Zellen mit "www." als "Hyperlink" aktivieren -----
Sub ActivateHyperlinks()
Dim rngCell As Range
With ActiveSheet
For Each rngCell In .UsedRange
If InStr(rngCell.Value, "www.") <> 0 Then
.Hyperlinks.Add Anchor:=.Range(rngCell.Address), _
Address:=rngCell.Value
End If
Next rngCell
End With
End Sub
'---- Hyperlink folgen, wenn "vb-fun" vorkommt -------------
Sub FollowHyperlink()
Dim hypLink As Hyperlink
Dim blnFound As Boolean
For Each hypLink In ActiveSheet.Hyperlinks
If InStr(hypLink.Name, "vb-fun") <> 0 Then
blnFound = True
Exit For
End If
Next
If blnFound Then hypLink.Follow NewWindow:=True
End Sub
|
|
|
Windows-Version |
95 |
|
|
98/SE |
|
|
ME |
|
|
NT |
|
|
2000 |
|
|
XP |
|
|
Vista |
|
|
Win
7 |
|
|
|
Excel-Version |
95 |
|
|
97 |
|
|
2000 |
|
|
2002
(XP) |
|
|
2003 |
|
|
2007 |
|
|
2010 |
|
|
|
|
Download (21,6
kB)
|
Downloads bisher: [ 1146 ]
|
|
|