[VBA] Tooltips on buttons - Bug on workbook change

[Eawyne]

Hi all ?

while looking for a method to add tooltips to buttons that didn't have hyperlinks on them, I found this code (unfortunately, I can't find where that was ; if anyone knows, thanks to point it out, I'll credit them where due) :

Option Explicit

Private WithEvents cmb As CommandBars

Private Type POINTAPI
    x As Long
    y As Long
End Type

#If 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
#Else
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
#End If

Private Sub Workbook_Open()
Call AddToolTipToShape(Shp:=Sheet1.Shapes("TPP"), _
    ScreenTip:="Ouvre le dossier TPP" & vbCrLf & vbCrLf & "TPP_Mask")

    Call AddToolTipToShape(Shp:=Sheet1.Shapes("TEC"), _
    ScreenTip:="Ouvre le dossier TEC" & vbCrLf & vbCrLf & "\TEC")

    Call AddToolTipToShape(Shp:=Sheet1.Shapes("FTP"), _
    ScreenTip:="Ouvre le FTP qui accède aux serveurs" & vbCrLf & vbCrLf & "Choix d'ouvrir un tuto au lancement")
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Call AddToolTipToShape(Shp:=Sheet1.Shapes("TPP"), _
    ScreenTip:="Ouvre le dossier TPP" & vbCrLf & vbCrLf & "TPP_Mask")

    Call AddToolTipToShape(Shp:=Sheet1.Shapes("TEC"), _
    ScreenTip:="Ouvre le dossier TEC" & vbCrLf & vbCrLf & "\TEC")

    Call AddToolTipToShape(Shp:=Sheet1.Shapes("FTP"), _
    ScreenTip:="Ouvre le FTP qui accède aux serveurs" & vbCrLf & vbCrLf & "Choix d'ouvrir un tuto au lancement")
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

It replaces (or even adds) tooltips with personalized content, which is great as it also runs on buttons that work with macros.

There's a little problem though when I switch from workbook to workbook. This erros happens :

Run-time error '1004' :
Application-defined or object-defined error

highlighting this variable :

    If InStr(1, "RangeNothing", TypeName(ActiveWindow.RangeFromPoint(tPt.x, tPt.y))) = 0 Then

I suppose that as it's mentionning the ActiveWindow, it will of course bug on that, but wouldn't there be a way to restrict this on the active workbook (which I tried doing, to no avail ; I tried to call the Cleanup on leaving the workbook but then couldn't find how to activate it again ?).

 

[Dan_W]

Hi. I could be wrong, but this looks like something that Jaafar Tribak coded. I see if I can find it, but in the interim, do you perhaps want try adding Application. before ActiveWindow? So the entire line should read:

If InStr(1, "RangeNothing", TypeName(Application.ActiveWindow.RangeFromPoint(tPt.x, tPt.y))) = 0 Then

and perhaps apply the same change on the two lines that also reference ActiveWindow.

Let me know how that goes...

 

[Dan_W]

Bingo - it is his code, and his where came from: https://www.mrexcel.com/board/threads/tooltip-and-macro-on-a-shape-in-excel-vba.442147/

This is useful, because others also experienced difficulties, but I think there situations are different to yours. The error message you got points to specific problem.

 

[Eawyne]

Ah shoot, I can't seem to be able to edit the first message - you still provided the source, that's cool.

And unfortunately, your solution doesn't fix the problem I tried to add the Application. on the lines below, but it didn't help either : same error message, same highlited line.

 

[Eawyne]

Ah shoot, I can't seem to be able to edit the first message - you still provided the source, that's cool.

And unfortunately, your solution doesn't fix the problem I tried to add the Application. on the lines below, but it didn't help either : same error message, same highlited line.

Argh, 10 min is too short !

I found the solution by going again through the post you mentionned ; some issues that I didn't understand before using the macro myself - plus your own idea - became clearer, and this post in particular brought the solution !

It probably wasn't the exact same problem, but his code also included some corrections regarding buttons spread on different sheets of the workbook, and so it seems to have resolved my own issue.

 

[Dan_W]

Well that's great that you managed to find the solution - I was going to suggest going through the handful of revisions he provided to those experiencing problems, so it's good that one of them was able to resolve it for you. His changes tended to focus on expanding the scope of things to ignore (because they weren't relevant - like a Range or Nothing - or because they caused issues with the operation of the code, like a dropdownbox) and then on ensuring that the object over which the mouse was hovering did in fact have a hyperlink. I had originally wondered if perhaps it was the first set that was causing you issues - that when you changed worksheets/workbooks, your mouse was inadvertently hovering over something that the code didn't recognise, thus throwing the error. Thank you for updating me - I was curious to know how it went!

 

[Eawyne]

Well that's great that you managed to find the solution - I was going to suggest going through the handful of revisions he provided to those experiencing problems, so it's good that one of them was able to resolve it for you. His changes tended to focus on expanding the scope of things to ignore (because they weren't relevant - like a Range or Nothing - or because they caused issues with the operation of the code, like a dropdownbox) and then on ensuring that the object over which the mouse was hovering did in fact have a hyperlink. I had originally wondered if perhaps it was the first set that was causing you issues - that when you changed worksheets/workbooks, your mouse was inadvertently hovering over something that the code didn't recognise, thus throwing the error. Thank you for updating me - I was curious to know how it went!

That was my first guess as well : as long as I hadn't shown any tooltip, no problem. But whenever I had hovered over an affected object, the issue arose, wherever I was over the object or not when alt-tabbing ; so I tried to see if I couldn't deactivate the macro when changing workbook, but it didn't work - and even if I had managed to do so, the result would've been cumbersome, at the very least.

The problem I have though is (even if I don't fully understand the intricacies of his code, I still manage to at least understsand what's happening), his comment about this last correction he provides seems to skip non-hyperlinked objects. However, I do have such objects, that run with a macro on their own, have no active hyperlink, but are still affected by his code. Is it that he calls hyperlinked objects the ones that are added to his code ? Or am I missing something at a core level ?