Option Explicit
Private WithEvents cmb As CommandBars
Private Type POINTAPI
x As Long
y As Long
End Type
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If"]#If[/URL] VBA7 Then
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else"]#Else[/URL]
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
[URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End"]#End[/URL] If
Private Sub Workbook_Open()
Call AddToolTipToShape(Shp:=Sheet1.Shapes("Rectangle 9"), _
ScreenTip:="This is tooltip for shape : 'Rectangle 9'" & vbCrLf & vbCrLf & "Click Shape to run Macro.")
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Call AddToolTipToShape(Shp:=Sheet1.Shapes("Rectangle 9"), _
ScreenTip:="This is tooltip for shape : 'Rectangle 9'" & vbCrLf & vbCrLf & "Click Shape to run Macro.")
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call CleanUp
End Sub
Private Sub AddToolTipToShape(ByVal Shp As Shape, ByVal ScreenTip As String)
On Error Resume Next
Shp.Parent.Hyperlinks.Add Shp, "", "", ScreenTip:=ScreenTip
Shp.AlternativeText = Shp.AlternativeText & "-ScreenTip"
Set cmb = Application.CommandBars
End Sub
Sub CleanUp()
Dim ws As Worksheet, Shp As Shape
On Error Resume Next
For Each ws In Me.Worksheets
For Each Shp In ws.Shapes
If InStr(1, Shp.AlternativeText, "-ScreenTip") Then
Shp.Hyperlink.Delete
Shp.AlternativeText = Replace(Shp.AlternativeText, "-ScreenTip", "")
End If
Next Shp
Next ws
End Sub
Private Sub cmb_OnUpdate()
Dim tPt As POINTAPI
GetCursorPos tPt
If InStr(1, "RangeNothing", TypeName(ActiveWindow.RangeFromPoint(tPt.x, tPt.y))) = 0 Then
If ActiveWindow.RangeFromPoint(tPt.x, tPt.y).OnAction <> "" Then
If GetAsyncKeyState(vbKeyLButton) Then
Application.Run (ActiveWindow.RangeFromPoint(tPt.x, tPt.y).OnAction)
End If
End If
End If
End Sub