Check Box tooltip

[Formula11]

Is there a way to have a tooltip come up for a Check Box, from the category Form Controls.
I have seen something using mouse over, but this was for the ActiveX Controls CheckBox.

 

[Jaafar Tribak]

No.
How about adding a comment to the cell underneath ?

You can use a vba workaround but it is an ugly hack

 

[Formula11]

Thanks for responding.
I came across one of your posts earlier for something similar, with a number of control options, but I don't think it had the Form Control Check Box.
With respect to your comment on writing to the cell underneath, I don't have any room as there are several check boxes.

I have used Comment boxes before that come up and are deleted, based on a check box selection.
Can something similar be done using mouse over?

CommentBoxCount = 0
For Each CommentBox In ActiveSheet.Shapes
     If CommentBox.Name = "Comment box" Then
        CommentBoxCount = CommentBoxCount + 1
    End If
Next CommentBox
If ActiveSheet.Shapes("Check Box 5").ControlFormat.Value <> 1 Then
    If CommentBoxCount = 0 Then
        With Range("RangeOutput").Parent
            CommentBoxWidth = 50
            CommentBoxHeight = 10
            CommentBoxLeft = 5
            CommentBoxTop = 5
            Set CommentBox = .Shapes.AddShape(msoShapeRectangle, CommentBoxLeft, CommentBoxTop, CommentBoxWidth, CommentBoxHeight)
            CommentBox.Name = "Comment box"
        End With
        With CommentBox
            .TextFrame.Characters.Text = "Manually fix"
        End With
    End If
End If
If ActiveSheet.Shapes("Check Box 5").ControlFormat.Value = 1 Then
    If CommentBoxCount = 1 Then
        ActiveSheet.Shapes("Comment box").Delete
    End If
End If

 

[Jaafar Tribak]

See if this works for you :

Workbook Demo






1- Add a dummy blank userform to your vba project and give the userform the name of : DummyForm

2- Add a Class Module and give the class the name of : IToolTip

3- Add the following code to the class module (Interface class):

Option Explicit


Public Sub Hook()
'
End Sub

Public Sub Shape(ByVal shp As Shape)
'
End Sub

Public Property Let ToolTipText(ByVal Text As String)
'
End Property

Public Property Let ToolTipTextColor(ByVal Color As Long)
'
End Property

Public Property Let ToolTipBackColor(ByVal Color As Long)
'
End Property

Public Property Let Left(ByVal L As Single)
'
End Property

Public Property Let Top(ByVal T As Single)
'
End Property

Public Property Let Width(ByVal W As Single)
'
End Property

Public Property Let Height(ByVal H As Single)
'
End Property

Public Property Let AutoSize(ByVal bAutoSize As Boolean)
'
End Property

4- Place the following code in the dummy userform module:

Option Explicit

Implements IToolTip

Private WithEvents cmbrs As CommandBars
Private WithEvents wb As Workbook


Private Type POINTAPI
    x As Long
    y As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetCursorPos Lib "user32.DLL" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetCursorPos Lib "user32.DLL" (lpPoint As POINTAPI) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
#End If

Private oShape As Shape
Private sngLeft As Single
Private sngTop As Single
Private sngWidth As Single
Private sngHeight As Single
Private sText As String
Private lTextColor As Long
Private lBackColor As Long
Private bAutoSize As Boolean



Private Sub IToolTip_Shape(ByVal shp As Shape)
    Set oShape = shp
End Sub

Private Property Let IToolTip_AutoSize(ByVal RHS As Boolean)
    bAutoSize = RHS
End Property

Private Property Let IToolTip_Left(ByVal RHS As Single)
    sngLeft = RHS
End Property

Private Property Let IToolTip_Top(ByVal RHS As Single)
    sngTop = RHS
End Property

Private Property Let IToolTip_Width(ByVal RHS As Single)
    sngWidth = RHS
End Property

Private Property Let IToolTip_Height(ByVal RHS As Single)
    sngHeight = RHS
End Property

Private Property Let IToolTip_ToolTipBackColor(ByVal RHS As Long)
    lBackColor = RHS
End Property

Private Property Let IToolTip_ToolTipTextColor(ByVal RHS As Long)
    lTextColor = RHS
End Property

Private Property Let IToolTip_ToolTipText(ByVal RHS As String)
    sText = RHS
End Property

Private Sub IToolTip_Hook()

    Dim i As Long, lCounter As Long
  
    oShape.AlternativeText = oShape.Name & "||" & sngLeft & "||" & sngTop & _
                                            "||" & sngWidth & "||" & sngHeight & "||" & sText & "||" & lTextColor & "||" & lBackColor
  

   For i = 0 To VBA.UserForms.Count - 1
        If VBA.UserForms(i).Name = "DummyForm" Then
            lCounter = lCounter + 1
            If lCounter > 1 Then Exit Sub
        End If
   Next i

    Set cmbrs = Application.CommandBars
    Call cmbrs_OnUpdate

End Sub


Private Sub cmbrs_OnUpdate()

    Const COLOR_INFOBK = 24
  
    Dim oObj As Object
    Dim oToolTip As Shape
    Dim tCurs As POINTAPI
    Dim vAttributes  As Variant
  
    On Error Resume Next
  
    If GetActiveWindow = Application.hwnd And ThisWorkbook Is ActiveWorkbook Then
        Call GetCursorPos(tCurs)
        Set oObj = ActiveWindow.RangeFromPoint(tCurs.x, tCurs.y)
        If InStr(1, "RangeNothing", TypeName(oObj)) = 0 Then
            If InStr(1, oObj.ShapeRange.AlternativeText, "||") Then
                vAttributes = Split(oObj.ShapeRange.AlternativeText, "||")
                oObj.Parent.Shapes("ToolTip").Delete
                If vAttributes(1) = 0 Then vAttributes(1) = oObj.Width / 2 + oObj.Left
                If vAttributes(2) = 0 Then vAttributes(2) = oObj.Height + oObj.Top + 10
                If vAttributes(3) = 0 Then vAttributes(3) = 100
                If vAttributes(4) = 0 Then vAttributes(4) = 25
                    Set oToolTip = oObj.Parent.Shapes.AddTextbox(msoTextOrientationHorizontal, vAttributes(1), vAttributes(2), vAttributes(3), vAttributes(4))
                    With oToolTip
                        .Name = "ToolTip"
                        If bAutoSize Then
                            .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
                        End If
                        .TextFrame.Characters.Text = vAttributes(5)
                        .TextFrame2.TextRange.Characters.Font.Fill.ForeColor.RGB = vAttributes(6)
                        If vAttributes(7) = 0 Then
                            vAttributes(7) = GetSysColor(COLOR_INFOBK)
                        End If
                        .Fill.ForeColor.RGB = vAttributes(7)
                    End With
            Else
                oObj.Parent.Shapes("ToolTip").Delete
            End If
        Else
            oObj.Parent.Shapes("ToolTip").Delete
        End If
      
        With Application.CommandBars.FindControl(ID:=2040)
            .Enabled = Not .Enabled
        End With
    End If

End Sub


Private Sub wb_BeforeClose(Cancel As Boolean)
         Set cmbrs = Nothing
End Sub

5- Code Usage example in a Standard Module: (example as per the workbook demo)

Option Explicit

Dim x As IToolTip     'Shape1
Dim y As IToolTip     'Shape2
Dim z As IToolTip     'Shape3


Public Sub Test()


    Set x = New DummyForm
    With x
        .Shape Sheet1.Shapes("Check Box 1")
        .Height = 20
        .Left = Sheet1.Shapes("Check Box 1").Left + Sheet1.Shapes("Check Box 1").Width / 2
        .Top = Sheet1.Shapes("Check Box 1").Top + Sheet1.Shapes("Check Box 1").Height + 10
        .Width = 150
        .ToolTipBackColor = &HFFFFC0
        .ToolTipText = "This is a tooltip demo ..."
        .ToolTipTextColor = vbBlue
        .Hook
    End With
  
  
    Set y = New DummyForm
    With y
        .Shape Sheet1.Shapes("Check Box 2")
        .Height = 0
        .Left = 0
        .Top = 0
        .Width = 0
        .AutoSize = True
        .ToolTipBackColor = &HC0C0FF
        .ToolTipText = "Hello world !!!"
        .ToolTipTextColor = vbRed
        .Hook
    End With
  
  
    Set z = New DummyForm
    With z
        .Shape Sheet1.Shapes("Smile")
        .Height = 150
        .Left = Sheet1.Shapes("Smile").Left + 50
        .Top = Sheet1.Shapes("Smile").Top + 80
        .Width = 200
        .ToolTipBackColor = 0
        .ToolTipText = String(500, "Long Entry")
        .ToolTipTextColor = vbBlack
        .Hook
    End With


End Sub

 

[Formula11]

Great, thank you, this works. It's quite detailed.