Tooltip text over a label

[John Robinson]

Is it possible to display a tool tip-text type label as the mouse
hovers over a label on an excel sheet. I can get a msgbox to come up
using Mousemove or click, but that requires a user interaction to
remove it. I would like a simple tiptext type message to appear as one
hovered over it and disappear as one moved on. Labels don't seem to
have this property.
My problem is a small label, which sometimes holds a long address and
I would like to be able to display it all as one hovers over it.
Thanks in advance for any help!

 

[Bob Phillips]

If we are talking control toolbar labels, you can try this

To do this, put the following code in a standard code module (making it
available to the whole workbook).

'------------- bas module ------------------------
Option Explicit

Declare Function GetSystemMetrics Lib "user32" ( _
ByVal nIndex As Long) As Long

Declare Function GetSysColor Lib "user32" ( _
ByVal nIndex As Long) As Long


Public Function CreateToolTipLabel(objHostOLE As Object, _
sTTLText As String) As Boolean
Dim objToolTipLbl As OLEObject
Dim objOLE As OLEObject

Const SM_CXSCREEN = 0
Const COLOR_INFOTEXT = 23
Const COLOR_INFOBK = 24
Const COLOR_WINDOWFRAME = 6

Application.ScreenUpdating = False 'just while label is created and
formatted

For Each objOLE In ActiveSheet.OLEObjects
If objOLE.Name = "TTL" Then objOLE.Delete 'only one can exist at a
time
Next objOLE

'create a label control...
Set objToolTipLbl = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Label.1")

'...and format it to look as a ToolTipWindow
With objToolTipLbl
.Top = objHostOLE.Top + objHostOLE.Height - 10
.Left = objHostOLE.Left + objHostOLE.Width - 10
.Object.Caption = sTTLText
.Object.Font.Size = 8
.Object.BackColor = GetSysColor(COLOR_INFOBK)
.Object.BackStyle = 1
.Object.BorderColor = GetSysColor(COLOR_WINDOWFRAME)
.Object.BorderStyle = 1
.Object.ForeColor = GetSysColor(COLOR_INFOTEXT)
.Object.TextAlign = 1
.Object.AutoSize = False
.Width = GetSystemMetrics(SM_CXSCREEN)
.Object.AutoSize = True
.Width = .Width + 2
.Height = .Height + 2
.Name = "TTL"
End With
DoEvents
Application.ScreenUpdating = True

'delete the tooltip window after 5 secs
Application.OnTime Now() + TimeValue("00:00:05"), "DeleteToolTipLabels"

End Function

Public Sub DeleteToolTipLabels()
Dim objToolTipLbl As OLEObject
For Each objToolTipLbl In ActiveSheet.OLEObjects
If objToolTipLbl.Name = "TTL" Then objToolTipLbl.Delete
Next objToolTipLbl
End Sub


'------------end of bas module -------------

Then in the code module for the sheet that has the control, add some
mousedown event code. To get to this module, right-click on the sheet name
tab, and select code (or double-click on the sheet name from within the VB
IDE). Here is an example of how to call it, assuming that the label
is called Label1

Private Sub Label1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Dim objTTL As OLEObject
Dim fTTL As Boolean

For Each objTTL In ActiveSheet.OLEObjects
fTTL = objTTL.Name = "TTL"
Next objTTL

If Not fTTL Then
CreateToolTipLabel Label1, "ToolTip Label"
End If

End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[John Robinson]

Thank you for replying. I have tried your suggestion but it does not
work. I am trying to get it to work hovering over a label in a
worksheet. It fell over at the adding a form line and wouldn't even
allow debug!
John Robinson


*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Jim Cone]

John,

This is a little simpler, it's not perfect, but it may
meet your needs.
Using an ActiveX label from the Control Toolbox,
set Wordwrap to False and Autosize to False.
The number "100" in the code is the width of the label.
Adjust to the actual width of your label.
Add the code to the Worksheet module.

'--------------------------------------------
Private Sub Label1_MouseMove(ByVal Button As Integer, _
ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If X > 100 Then
Label1.AutoSize = False
Label1.Width = 100
Else
Label1.AutoSize = True
End If
End Sub
'-----------------------------------------------

Regards,
Jim Cone
San Francisco, USA

 

[Bob Phillips]

Probably just wrap-around.Change these lines

Application.ScreenUpdating = False 'just while label is created and
formatted

For Each objOLE In ActiveSheet.OLEObjects
If objOLE.Name = "TTL" Then objOLE.Delete 'only one can exist at a
time
Next objOLE

to

Application.ScreenUpdating = False 'just while label is created
'and formatted

For Each objOLE In ActiveSheet.OLEObjects
If objOLE.Name = "TTL" Then objOLE.Delete 'only one can exist
'at a time
Next objOLE


--

HTH

RP
(remove nothere from the email address if mailing direct)