MouseOver Substitute in XL

G

Guest

I realize there is no mouseover event in XL. However, I have built a
flowchart in XL and added OnAction events to the shapes. Therefore whenever
my mouse is over one of the flowchart shapes, it's changes into the hand
pointer. Is there someway to trigger a type of mouseover event from this?

What I ultimately want is whenever the mouse is over a shape, show a popup
message or balloon that displays a magnified view of the shape's caption or
something along those lines.

If any of this is possible I would really appreciate some guideance.
 
G

Guest

The best solution as I see is to exploit the MouseMove event offered by most
OLEObjects available through the Control Toolbox tool bar. What you can do is
replace your shapes with, say, labels from this tool bar.

Suggested is that you:
1. Have the event code of each of the labels hide the popup of all other
labels and display its own, and/or
2. Superimpose the visible flowchart labels over top of larger transparent
labels such that the mouse pointer must cross over the perimeter of the
transparent (invisible) labels when it moves away from the visible label. The
visible label event code shows the popup message and the transparent labels
event code hides it.

The above are admitedly kludges. Appended is code that will demo option 2
above. The code will only set up the worksheet for the demo. Otherwise is not
of any value.

Minimal testing. Correct word wrap.


Sub PopupMessageKludge()
Dim Lb_l As OLEObject, Lb_2 As OLEObject
Dim tb As Shape
Dim ws As Worksheet
Dim cm As Object
Dim txt As String

Set ws = Worksheets.Add
ws.Name = "Demo"
ActiveWindow.DisplayGridlines = False
Set Lb_l = ws.OLEObjects.Add("Forms.Label.1", Left:=100, _
Top:=100, Width:=150, Height:=150)
With Lb_l
.Object.Caption = ""
.Name = "Background1"
End With
Set Lb_2 = ws.OLEObjects.Add("Forms.Label.1", Left:=130, _
Top:=130, Width:=90, Height:=90)
Lb_2.Name = "FlowChartLabel"
With Lb_2.Object
.Caption = " Hello World !!!"
.Font.Size = 10
.BackColor = 13434879
End With
Set tb = ws.Shapes.AddShape(1, 110, 100, 150, 15)
tb.Name = "Popup Message"
tb.Shadow.Type = 14
tb.Visible = False
With tb.TextFrame.Characters
.Text = Lb_2.Object.Caption
.Font.Size = 10
.Font.Color = vbRed
End With
ws.Protect

txt = "Private Sub FlowChartLabel_MouseMove(ByVal Button As Integer, _" &
vbCr & _
"ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)" & vbCr & _
"With ActiveSheet.Shapes(""Popup Message"")" & vbCr & _
" If Not .Visible Then .Visible = True" & vbCr & _
"End With" & vbCr & _
"End Sub" & vbCr & _
"Private Sub Background1_MouseMove(ByVal Button As Integer, _" & vbCr & _
"ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)" & vbCr & _
"With ActiveSheet.Shapes(""Popup Message"")" & vbCr & _
" If .Visible Then .Visible = False" & vbCr & _
"End With" & vbCr & _
"End Sub"

Set cm = Application.VBE.ActiveVBProject. _
VBComponents(ws.CodeName).CodeModule
cm.InsertLines cm.CountOfLines + 1, txt
End Sub

Regards,
Greg
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top