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!
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).
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