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! Already a Member? Login


White Paper - A Guide to 3D Printing Materials
When it comes to using an FDM 3D printer effectively and efficiently, choosing the right material at the right time is essential. This 3D Printing Materials Guide will help give you and your team a basic understanding of some FDM 3D printing polymers and composites, their strengths and weaknesses, and when to use them. Download Now

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