Option Explicit
Enum TIP_POSITION
TOP_LEFT = 0
TOP_RIGHT = 1
BOT_LEFT = 3
BOT_RIGHT = 4
LEFT_ALIGN = 5
RIGHT_ALIGN = 6
TOP_ALIGN = 7
BOT_ALIGN = 8
CUSTOM_ALIGN = 9
End Enum
Public Function showTipPro(ctrl As Control, _
Optional position As TIP_POSITION = TIP_POSITION.RIGHT_ALIGN, _
Optional posTop As Long, Optional posLeft As Long, _
Optional tipTextOverride As String = "")
'AUTHOR: xrx101
'PURPOSE: Replaces form control tooltips that fail display promptly or be positioned to your liking
'REQUIRE: 1) Must have a label on form named 'lblTip'
' 2) On each form control you want to use showTipPro:
' a) Store the tip text in the control's Tag property
' b) Set event code for MouseMove on the control (see form module code)
' c) Set event code for MouseMove on the form (see form module code)
Const SPACER As Integer = 90 '- 90 seems to work well, but adjust based on circumstances
' '- if more control needed, code to include adjustments for short, medium, and long text strings
Const POS_CENTER = True 'On TOP and BOT aligns, it WILL center the label across the control
' Const POS_CENTER = False 'On TOP and BOT aligns, it WON'T center the label across the control
Dim lbl As Label
Dim tipText As String
'Figure out the text situation: we use tipTextOverride if provided, otherwise use the control.tag or set to ""
tipText = Trim(tipTextOverride)
If tipText = "" Then
If Trim(ctrl.Tag) <> "" Then tipText = Trim(ctrl.Tag)
End If
Set lbl = ctrl.Parent.Controls("lblTip")
With lbl
.Visible = False
If tipText = "" Then
.ForeColor = RGB(255, 20, 20)
.Caption = "PUT TOOLTIP TEXT IN " & ctrl.Parent.Name & "." & ctrl.Name & ".Tag PROPERTY!"
'OR use tipTextOverride to set the value of tipText
Else
.ForeColor = RGB(80, 80, 80)
.Caption = tipText
End If
.Width = Len(.Caption) * 1.1 * SPACER
.BackColor = RGB(255, 255, 200)
.TextAlign = 2 '2 is Centered see: learn.microsoft.com/en-us/office/vba/api/Access.TextBox.TextAlign
'Positioning from top left continuing clockwise around the control
Select Case position
Case TIP_POSITION.TOP_LEFT
.Top = ctrl.Top - .Height - SPACER
.Left = ctrl.Left - .Width - SPACER
Case TIP_POSITION.TOP_ALIGN
.Top = ctrl.Top - .Height - SPACER
.Left = IIf(Not POS_CENTER, ctrl.Left, ctrl.Left + (ctrl.Width / 2) - (.Width / 2))
Case TIP_POSITION.TOP_RIGHT
.Top = ctrl.Top - .Height - SPACER
.Left = ctrl.Left + ctrl.Width + SPACER
Case TIP_POSITION.RIGHT_ALIGN
.Top = ctrl.Top
.Left = ctrl.Left + ctrl.Width + SPACER
Case TIP_POSITION.BOT_RIGHT
.Top = ctrl.Top + .Height + SPACER
.Left = ctrl.Left + ctrl.Width + SPACER
Case TIP_POSITION.BOT_ALIGN
.Top = ctrl.Top + .Height + SPACER
.Left = IIf(Not POS_CENTER, ctrl.Left, ctrl.Left + (ctrl.Width / 2) - (.Width / 2))
Case TIP_POSITION.BOT_LEFT
.Top = ctrl.Top + .Height + SPACER
.Left = ctrl.Left - .Width - SPACER
Case TIP_POSITION.LEFT_ALIGN
.Top = ctrl.Top
.Left = ctrl.Left - .Width - SPACER
Case TIP_POSITION.CUSTOM_ALIGN
.Top = posTop
.Left = posLeft
End Select
.Visible = True
End With
End Function