Log In

Come Join Us!

Are you an
Engineering professional?
Join Eng-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Eng-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here


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

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

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


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

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

Sub FirstPage()
    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140
    'Application.ActiveWindow.ViewFit = visFitPage
    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
    Set stnObj = Application.Documents.OpenEx("SERVER_M.VSS", visOpenDocked)
    Set mstObjConnector = stnObj.Masters("Dynamic connector")

    'Active main page
    '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)"

    '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.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)"

    '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.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)"
    '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.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"")"

    Application.EndUndoScope UndoScopeID1, True
    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices
    Visio.Application.Addons("dbrs").Run "shpObjSever"
End Sub

Sub BemisShow()

MsgBox "Welcome!"

End Sub

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Eng-Tips Forums free from inappropriate posts.
The Eng-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Eng-Tips forums is a member-only feature.

Click Here to join Eng-Tips and talk with other members!


Close Box

Join Eng-Tips® Today!

Join your peers on the Internet's largest technical engineering professional community.
It's easy to join and it's free.

Here's Why Members Love Eng-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close