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
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
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