Eawyne
New Member
- Joined
- Jun 28, 2021
- Messages
- 44
- Office Version
- 2013
- Platform
- Windows
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) :
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 :
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 ?).
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) :
VBA Code:
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 :
VBA Code:
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 ?).