Ja! So ist das, die HL-Fkt ist kein echter HL, ...
31.01.2015 15:38:56
Luc:-?
…bellandi;
.Hyperlinks ist eine objektbegründende Range-Eigenschaft. Das kann niemals eine Fml sein! Die Zelle hat also diese Eigenschaft nicht und damit fktn auch die entsprd Methoden nicht.
Ich gebe dir hier mal ein komplexes, aber noch relativ einfaches Bsp (an einem umfassenderen arbeite ich noch), das zumindest als Bsp für deine Zwecke ausreichen sollte:
Option Explicit
Rem Folgt vorhandenem bzw erzeugt neuen HLink lt angegeb Parametern
' Hinws: Benötigt udF LinkAdresse! Param b.Tasten-KurzRuf unmögl!
' Vs1.1 -LSr -cd:20141212 -1pub:20141214herber -lUpd:20141214
Sub FolgeHL(ParamArray ZielAdresse())
Dim LiTrZ$, hlAdr
On Error Resume Next
LiTrZ = Application.International(xlListSeparator)
If Not IsMissing(ZielAdresse) Then
hlAdr = Array(CStr(ZielAdresse(0)), CStr(ZielAdresse(1)))
Else: hlAdr = LinkAdresse(ActiveCell)
End If
If IsError(hlAdr) Then Exit Sub
If IsArray(hlAdr) Then
ActiveWorkbook.FollowHyperlink hlAdr(0), hlAdr(1)
ElseIf IsError(Range(Replace(hlAdr, LiTrZ, ","))) Then
If ActiveCell.HyperLinks(1).Address = "" Then
ActiveWorkbook.FollowHyperlink "#" & hlAdr
Else: ActiveWorkbook.FollowHyperlink hlAdr
End If
Else: Application.Goto Range(Replace(hlAdr, LiTrZ, ","))
End If
End Sub
Rem Liefert ZielAdressen echter u.v.Fml-Hyperlinks in 1er xlBlatt-Zelle
' Erweiterung d.TrivialVariante* f.echte ExtHLinks auf div IntHLinks;
' nur f.A1-Bezüge! (* Quelle: J.Hennekes)
' Vs1.1 -LSr -cd:20141212 -1pub:(1.0)20141213herber -lUpd:20141214
Function LinkAdresse(Zelle As Range)
Dim klDif(1) As Long, kp As Long, hlAdr
On Error Resume Next
With Zelle.HyperLinks
If CBool(.Count) Then
If .Item(1).Address = "" Then
LinkAdresse = .Item(1).SubAddress
ElseIf .Item(1).SubAddress "" Then
With .Item(1)
LinkAdresse = Array(.Address, .SubAddress)
End With
Else: LinkAdresse = .Item(1).Address
End If
ElseIf Zelle.HasFormula Then
hlAdr = Zelle.Formula
If CBool(InStr(hlAdr, "HYPERLINK(")) Then
hlAdr = Split(hlAdr, "HYPERLINK(")
klDif(0) = Len(Replace(hlAdr(0), ")", ""))
klDif(1) = Len(Replace(hlAdr(0), "(", "")) - 1
For kp = 1 To klDif(0) - klDif(1)
hlAdr(1) = Left(hlAdr(1), InStrRev(hlAdr(1), ")") - 1)
Next kp
If Right(hlAdr(1), 1) ")" Then _
kp = InStrRev(hlAdr(1), ",") Else kp = 0
If kp > InStrRev(hlAdr(1), ")") Then hlAdr(1) = Left(hlAdr(1), kp - 1)
If CBool(InStr(hlAdr(1), "(") + InStr(hlAdr(1), """#""&")) Then
LinkAdresse = Evaluate(hlAdr(1))
If LinkAdresse = hlAdr(1) Then LinkAdresse = CVErr(xlErrRef)
Else: LinkAdresse = Replace(hlAdr(1), """", "")
End If
If IsError(LinkAdresse) Then
ElseIf Left(LinkAdresse, 1) = "#" Then
LinkAdresse = Mid(LinkAdresse, 2)
End If
Else: LinkAdresse = CVErr(xlErrRef)
End If
Else: LinkAdresse = CVErr(xlErrNA)
End If
End With
End Function
Wie du an der Vorbemerkung sehen kannst, hättest du das auch im Archiv finden können! RECHERCHE! Da kann noch mehr sein!
Gruß, Luc :-?