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 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Montag, 25. Juli 2011