[VBA Visio] When running mode, Double Event can not handle

[homekung]

When edit mode , I can double click the shape and method (that I call when click shape) is running. But when in running mode (F5) I double the shape but nothing happen

What should I do ?

Thanks

[homekung]

This is my code


Sub ClearShapeonPage()
Dim shp As Visio.Shape
Dim I As Long, N As Long
N = ActivePage.Shapes.Count
For I = N To 1 Step -1
ActivePage.Shapes(I).Delete
Next
End Sub
Sub FirstPage()
'Enable diagram services
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140
'Application.ActiveWindow.ViewFit = visFitPage
ClearShapeonPage
Application.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation).FormulaForceU = "2"
Application.EndUndoScope UndoScopeID1, True
Application.Documents.OpenEx "server_u.vss", visOpenRO + visOpenDocked
Application.Documents.OpenEx "netloc_u.vss", visOpenRO + visOpenDocked
Application.Documents.OpenEx "comps_u.vss", visOpenRO + visOpenDocked
'Connection
Set stnObj = Application.Documents.OpenEx("SERVER_M.VSS", visOpenDocked)
Set mstObjConnector = stnObj.Masters("Dynamic connector")

'Active main page
Application.Windows.ItemEx("test").Activate

'KMS --> shpObjSever
Dim shpObjSever As Visio.Shape
Set shpObjSever = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 3.543307, 4.822835)
'Add Color *** Read Status from DB
shpObjSever.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(255,0,0))"
For Each objShape In shpObjSever.Shapes
objShape.CellsU("FillForegnd").FormulaForceU = "RGB(255,0,0)"
Next

'GDS --> shpObjGDS and Connect to KMS
Dim shpObjGDS As Shape
Set shpObjGDS = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 6.732283, 6.988189)
Set shpObjConnector1 = ActivePage.Drop(mstObjConnector, 0, 0)
shpObjConnector1.SendToBack
shpObjConnector1.Cells("BeginX").GlueTo shpObjSever.Cells("Connections.X1")
shpObjConnector1.Cells("EndX").GlueTo shpObjGDS.Cells("Connections.X1")
'Add Color *** Read Status from DB
shpObjGDS.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(0,255,0))"
For Each objShape In shpObjGDS.Shapes
objShape.CellsU("FillForegnd").FormulaForceU = "RGB(0,255,0)"
Next
'VKB --> shpObjGDS and Connect to KMS
Dim shpObjVKB As Shape
Set shpObjVKB = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 6.732283, 4.822835)
Set shpObjConnector2 = ActivePage.Drop(mstObjConnector, 0, 0)
shpObjConnector2.SendToBack
shpObjConnector2.Cells("BeginX").GlueTo shpObjSever.Cells("Connections.X1")
shpObjConnector2.Cells("EndX").GlueTo shpObjVKB.Cells("Connections.X1")
'Add Color *** Read Status from DB
shpObjVKB.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(0,255,0))"
For Each objShape In shpObjVKB.Shapes
objShape.CellsU("FillForegnd").FormulaForceU = "RGB(0,255,0)"
Next


'Bemis --> shpObjGDS and Connect to KMS
Dim shpObjBemis As Shape
Set shpObjBemis = Application.ActiveWindow.Page.Drop(Application.Documents.Item("SERVER_M.VSS").Masters.ItemU("Web server"), 6.732283, 2.46063)
Set shpObjConnector3 = ActivePage.Drop(mstObjConnector, 0, 0)
shpObjConnector3.SendToBack
shpObjConnector3.Cells("BeginX").GlueTo shpObjSever.Cells("Connections.X1")
shpObjConnector3.Cells("EndX").GlueTo shpObjBemis.Cells("Connections.X1")
'Add Color *** Read Status from DB
'shpObjBemis.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick).FormulaU = "RUNADDON(""NewMacros.BemisShow"")"
shpObjBemis.Cells("EventDblClick").FormulaU = "RUNADDON(""NewMacros.BemisShow"")"
'shpObjBemis.Cells("FillForegnd").FormulaU = "THEMEGUARD(RGB(0,255,0))"
For Each objShape In shpObjBemis.Shapes
objShape.CellsU("FillForegnd").FormulaForceU = "RGB(0,255,0)"
'objShape.CellsU("EventDblClick").FormulaForceU = "RUNADDON(""NewMacros.BemisShow"")"
Next
Application.EndUndoScope UndoScopeID1, True
'Restore diagram services
ActiveDocument.DiagramServicesEnabled = DiagramServices

Visio.Application.Addons("dbrs").Run "shpObjSever"
End Sub
Sub BemisShow()
MsgBox "Welcome!"
UserForm1.Show
End Sub