[email protected]#mailto:[email protected]#Public Function GetHyperlinkRawData(ByVal hyperlinkData As Variant) As Variant
GetHyperlinkRawData = hyperlinkData
End Functiontek tıklamaya yanıt vermesi için
Private Sub txtHyperlinkFullAddress_Click()
On Error GoTo txtHyperlinkFullAddress_Click_Err
If Not IsNull(Me.txtHyperlinkFullAddress.Value) Then
Application.FollowHyperlink Me.txtHyperlinkFullAddress.Value
End If
Exit Sub
txtHyperlinkFullAddress_Click_Err:
Call MsgBox("Error " & Err.Number & " - " & Err.Description & " (in " & Me.Name & ".txtHyperlinkFullAddress_Click)")
End SubDisplayText'i köprü sütunundan ayıklamak için
Public Function GetHyperlinkDisplayText(ByVal hyperlinkData As Variant) As Variant
Const SEPARATOR As String = "#"
Dim retVal As Variant
Dim tmpArr As Variant
If IsNull(hyperlinkData) Then
retVal = hyperlinkData
Else
tmpArr = Split(hyperlinkData, SEPARATOR)
If Len(tmpArr(0)) > 0 Then
retVal = tmpArr(0)
Else
retVal = tmpArr(1)
If Len(tmpArr(2)) > 0 Then
retVal = retVal & "#" & tmpArr(2)
End If
End If
End If
GetHyperlinkDisplayText = retVal
End FunctionDisplayText i almak için
Public Function GetHyperlinkFullAddress(ByVal hyperlinkData As Variant, Optional ByVal removeMailto As Boolean) As Variant
Const SEPARATOR As String = "#"
Dim retVal As Variant
Dim tmpArr As Variant
If IsNull(hyperlinkData) Then
retVal = hyperlinkData
Else
If InStr(hyperlinkData, SEPARATOR) > 0 Then
' I append 4 separators at the end, so I don't have to worry about the
' lenght of the array returned by Split()
hyperlinkData = hyperlinkData & String(4, SEPARATOR)
tmpArr = Split(hyperlinkData, SEPARATOR)
If Len(tmpArr(1)) > 0 Then
retVal = tmpArr(1)
If Len(tmpArr(2)) > 0 Then
retVal = retVal & "#" & tmpArr(2)
End If
End If
Else
retVal = hyperlinkData
End If
If Left(retVal, 7) = "mailto:" Then
retVal = Mid(retVal, 8)
End If
End If
GetHyperlinkFullAddress = retVal
End Function
