"Ask on drop" property over written when using AddMember

[tmcquinn]

I have some VBA that adds a shape to a container on drop from a stencil. However, when it executes it automatically closes (or doesn't allow) the dialog box that asks for the shapes data to appear. Is there a way I can wait on user input into "ask on drop" dialog box for shape data before adding shapes to the container?

Here is my VBA code:

Private Sub Document_ShapeAdded(ByVal vsoShape As Visio.IVShape)
Dim vsoMaster As Visio.Master
Dim containerX As Double
Dim containerY As Double
Dim stencil As Visio.Document
Dim vsoShapex As Visio.Shape
Dim container As Visio.ContainerProperties


'Get the Master property of the shape.
Set vsoMaster = vsoShape.Master
'Check whether the shape has a master. If not,
'the shape was created locally.
If Not (vsoMaster Is Nothing) Then
     
     If vsoMaster.Name = "Dialog Context" Then
         containerX = Format(vsoShape.Cells("PinX").Result("inches"), "000.000")
         containerY = Format(vsoShape.Cells("PinY").Result("inches"), "000.000")

         Set container = vsoShape.ContainerProperties
         
         If Not (container Is Nothing) Then
            Visio.Documents.OpenEx Visio.Documents(1).Path + "My Shapes\current_shapes.vssx", visOpenDocked
            Set vsoShapex = ActivePage.Drop(Visio.Documents("current_shapes.vssx").Masters("Attempt Box"), containerX, containerY)

            container.AddMember vsoShapex, VisMemberAddOptions.visMemberAddExpandContainer
           
        End If
     End If
End If
End Sub

I can provide the Visio Document if that would help as well!

[Yacine]

You'll probably be better off by calling the dialog after the shape has been dropped.
You know your shape (= vsoShape), know just call the docmd(1312).

[tmcquinn]

Thanks that did the trick! Here's my updated code in case someone else runs into the problem.

Private Sub Document_ShapeAdded(ByVal vsoShape As Visio.IVShape)
    'Declare some hard-coded positioning values
    Dim WIDTH_DIV As Double: WIDTH_DIV = 3
    Dim HEIGHT_DIV As Double: HEIGHT_DIV = 4
    Dim WIDTH_OFFSET As Double: WIDTH_OFFSET = 0.5
   
    'Declare variables used throughout
    Dim stencil As Visio.Document
    Dim container As Visio.ContainerProperties
    Dim vsoMaster As Visio.Master
    Dim vsoShapeA As Visio.Shape
    Dim vsoShapeR As Visio.Shape
    Dim containerX As Double
    Dim containerY As Double
    Dim containerHeight As Double
    Dim containerWidth As Double
    Dim counter As Integer: counter = 0
    Dim memberID As Variant
    'Get the Master property of the shape.
    Set vsoMaster = vsoShape.Master
   
    'Check whether the shape has a master. If not, the shape was created locally.
    If Not (vsoMaster Is Nothing) Then
   
    ' Need to check if we are looking at a Dialog Context
   
        If (vsoMaster.Name = "Dialog Context") Then
            ' Gather position/size information
            containerX = Format(vsoShape.Cells("PinX").Result("inches"), "000.000")
            containerY = Format(vsoShape.Cells("PinY").Result("inches"), "000.000")
            containerHeight = Format(vsoShape.Cells("Height").Result("inches"), "000.000")
            containerWidth = Format(vsoShape.Cells("Width").Result("inches"), "000.000")
           
            ' Identifying container
            Set container = vsoShape.ContainerProperties
           
            ' To catch a user using undo so we dont add extra shapes when its not needed!
           
            If container Is Nothing Then
                Exit Sub
            End If
           
            For Each memberID In container.GetMemberShapes(visContainerFlagsDefault)
                Exit Sub
            Next
           
            ' An error occurs if the shape data isn't updated on drop and causes the script
            ' to crash. To fix this is catch the error and yell at the user. This allows the
            ' shape data to be set to its default values if new input isn't given.
            On Error GoTo ErrorHandler
               vsoShape.ContainerProperties.Application.DoCmd (1312)
           
            ' Adding shape 1 and shape 2 to the container
            If Not (container Is Nothing) Then
                ' If Errors begin to occur, look into opening stencil relatively.
           
                ' Add Shape 1 to page
                Set vsoShapeA = ActivePage.Drop(Visio.Documents("temp_stencil.vssx").Masters("Shape 1"), _
                    containerX - (containerWidth / WIDTH_DIV + WIDTH_OFFSET), containerY + containerHeight / HEIGHT_DIV)
                   
                ' Add Shape 2 to page
                Set vsoShapeR = ActivePage.Drop(Visio.Documents("temp_stencil.vssx").Masters("Shape 2"), _
                    containerX + (containerWidth / WIDTH_DIV - WIDTH_OFFSET), containerY - containerHeight / HEIGHT_DIV)
               
               ' Add both shapes as members of the container and allow expansion
               container.AddMember vsoShapeA, VisMemberAddOptions.visMemberAddExpandContainer
               container.AddMember vsoShapeR, VisMemberAddOptions.visMemberAddExpandContainer
           End If
        End If
    End If
Exit Sub


ErrorHandler:
    MsgBox "Failed to update shape data"
    Resume Next
End Sub