Consulting

Results 1 to 2 of 2

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

  1. #1
    VBAX Newbie
    Joined
    Jun 2010
    Posts
    2
    Location

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

    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

  2. #2
    VBAX Newbie
    Joined
    Jun 2010
    Posts
    2
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •