PDA

View Full Version : show the entry of drop down when mouse over a particular value is done



Anusree
10-01-2010, 12:50 AM
Hi,
I have created a drop down in A1 of sheet1 using the below code:

Set rng = Worksheets("sheet1").Range("A1")
Set lb = Sheet1.DropDowns.Add(Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height, Editable:=False)
lb.AddItem "Hai....I would like to read books on fiction."
lb.AddItem "Hai....I would like to read short stories."
lb.AddItem "Hai....I would like to read novels."

When i try to read the first entry of the drop down, i am not able to see the entire text which is present there because the size of the dropdown matches with the size of the cell but does not match with the length of the first entry. That is,
When i try to read "Hai....I would like to read books on fiction." which is the first entry, I can see only till "Hai....I " because of size problem i mentioned above.

My requirement:
Whenever i keep mouse over an entry in the dropdown, i want to show the full content to the user. Is there any way i could achieve this?

Regards,
Anu

Jan Karel Pieterse
10-01-2010, 05:28 AM
Put this code in a normal module:

Option Explicit
Dim moShape As Object
Sub ShowMyValue(sText As String, sngTop As Single, sngLeft As Single, sngWidth As Single, sngHeight As Single)
If moShape Is Nothing Then
Set moShape = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, sngTop, sngLeft, sngWidth, sngHeight)
With moShape
'Now position properly
.Top = sngTop - sngHeight
.Left = sngLeft
End With
moShape.TextFrame.Characters.Text = sText
End If
End Sub
Sub HideMyValue()
If Not moShape Is Nothing Then
ActiveSheet.DrawingObjects(moShape.Name).Delete
Set moShape = Nothing
End If
End Sub

And this code in the module behind the sheet:

Option Explicit

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With ComboBox1
ShowMyValue .Text, .TopLeftCell.Top, .TopLeftCell.Left, 200, .Height
Application.OnTime Now + TimeValue("00:00:03"), "HideMyValue"
End With
End Sub


(adjust the code to match your combo's name, adjust the 200 according to how wide you want the textbox to appear.)

Kenneth Hobs
10-01-2010, 09:58 AM
Jan posted an excellent solution as usual.

In the tweak below, I made the textbox size to be dynamically sized. The first two subs dynamically size the combobox.

Private oLenCombobox1 As Single

Private Sub ComboBox1_GotFocus()
Dim i As Long, d As Single
d = 0
With ComboBox1
oLenCombobox1 = .Width
For i = 0 To UBound(.List)
If Len(.List(i)) > d Then d = Len(.List(i))
Next i
d = .Font.Size * d * 0.45
.Width = d
.ListWidth = d
End With
End Sub

Private Sub ComboBox1_LostFocus()
ComboBox1.Width = oLenCombobox1
End Sub


Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
With ComboBox1
ShowMyValue .Text, .TopLeftCell.Top, .TopLeftCell.Left, .Font.Size * Len(.Text) * 0.4, .Height
Application.OnTime Now + TimeValue("00:00:02"), "HideMyValue"
End With
End Sub