Page tree

Versions Compared


  • This line was added.
  • This line was removed.
  • Formatting was changed.


How I intercept Hyperlinks via XLAM Addon


No Format
Public WithEvents appevent As Application

Private Sub appevent_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
 Debug.Print "Following Hyperlink Class"
 Call OpenHyperLinksEvent(Sh, Target)
End Sub


No Format
Public myobject As New AppEvent_SheetSelectionChange
Public Sub OpenHyperLinksEvent(Optional ByVal Sh As Object, Optional ByVal Target As Hyperlink)
 Set myobject.appevent = Application
 Debug.Print "OpenHyperLinksEvent Sub"
 On Error GoTo EndExit
 Debug.Print Target.Range.Comment.Text
 Call OpenIEURL(CStr(Target.Range.Comment.Text), True)
End Sub
Sub Test()
 Call OpenHyperLinksEvent
End Sub
Public Sub RangeHyperlinksToComments(ColNum As Integer)
 'ColNum = 1
 Dim rcell As Range, Rng As Range, HyperLinkRefRng As Range, HyperLinkStr As String, CellStr As String

 lrow = Get_lRow(ActiveSheet)
 Set Rng = Range(Cells(2, ColNum), Cells(lrow, ColNum))

 For Each rcell In Rng.Cells
  If Not IsError(rcell.Value) Then
   If rcell.Value <> "" Then
    If rcell.Hyperlinks.Count = 1 Then
     HyperLinkStr = HyperLinkURLFromCell(rcell)
     CellStr = rcell.Value

     With rcell.Hyperlinks
      .Add _
      Anchor:=rcell, _
      Address:="", _
      SubAddress:=rcell.Address, _
      ScreenTip:="", _
     End With

     rcell.Comment.Visible = False
     rcell.Comment.Text Text:=HyperLinkStr

    End If
   End If
  End If
 Next rcell

End Sub


No Format
Option Explicit
Private xlApp As New XL_SheetSelectionChange
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Set xlApp.XL = Nothing
End Sub
Private Sub Workbook_Open()
 Call OpenHyperLinksEvent
End Sub