VBA to add a screentip to a macro-enabed button

[scotthannaford1973]

Hi all

I am using a shape (Rectangle 9) as a button with a macro assigned to it (ExpandFuture) and I'd like to add a screen-tip for when people hover over the button. So just basic text... but importantly the macro still has to run when the click the button. Have found a few suggestions but none of them work!

 

[Kyle123]

You're better off not using ActiveX controls on worksheets. They're unstable and it's asking for trouble, if you want to see what I mean, google ActiveX resizing on worksheet

 

[Yongle]

@scotthannaford1973

If you share @Kyle123's concerns...
- the solution in post#10 works equally well with Form Control buttons
- but there is less flexibility over the look of those buttons

 

[scotthannaford1973]

Nothing seems to work for you

I normally get good suggestions to work.... patronising

 

[scotthannaford1973]

How about this :

The code below assumes the shape is Rectangle 9 and it is located in Sheet1 .. Change these as required.

Code in the ThisWorkbook Module:

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

The code should enable the shape to display a ScreenTip when the user hover over it while still permitting to run the associated Macro ExpandFuture

cheers, Jaafar - works like a dream (with a bit of personalisation )

 

[Eawyne]

Some years later, I had a need for this, and it worked like a charm on my own code Thanks a lot !