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