Selection within a selection in a Master's instances, programmatically

[Gustavo]

Hi All.

I've made a vsoMaster shape, which has 2 sub-shapes. Subshape_1 has bunch of Prop.datarows, and Subshape_2 is a group which displays some visualizations of Subshape_1's Prop.datarows.
The solution has lots of those vsoMaster instances, so I've also made a custom VBA Userform, for the user of the solution to bulkfill some of those Prop.datarows of some of vsoMaster instances, selected also by the user.
This code @ Userform (...I know, i know... workin' on it), works well when the user select a single vsoMaster instance, or Ctrl+click several Subshape_1 of several instances, and hits the commandbutton that execute:

Code Select Expand


Private Sub bulkfill_subshape1datarows()
    Dim vsoShape As Visio.Shape
    Dim sel As Visio.Selection
        Set sel = Visio.ActiveWindow.Selection
        sel.IterationMode = visSelModeSkipSuper    'Skipping 1rst group superselected shapes'
        For Each vsoShape In sel
            If vsoShape.CellExists("Prop.datarow1.Value", visExistsAnywhere) Then
                vsoShape.Cells("Prop.datarow1.Value").FormulaForce = Chr(34) & Me.TextBoxdatarow1.Value & Chr(34)
                Debug.Print "It's written" & Me.TextBoxdatarow1.Value & " en " & vsoShape.ID
            End If
        Next
    MsgBox "Its captured " & Me.TextBoxdatarow1.Value & " in " & sel.Count & " instances.", vbOKOnly,     
Set sel = Nothing
End Sub



But it wont work when the user select the instances with the area selection or the lasso selection tool. This is, I assume, that when the user select the instances with the area or lasso tool, it creates a Selection of the group of instances as superselected selection, so each vsoMaster instance is a subselected shape, leaving my target Subshape_1 out of the sel.Iterationmode options. I have to create a selection within the selection. How can I acomplish it? any ideas appreciated.

[Gustavo]

Well, it took me a little. Always the subselection in shapes are kinda long to debug and test, but I did a working version. I feel there must be a simpler way to do it but it does the trick. Used several posts around about the topic. This is the code:

Code Select Expand


Private Sub Writesubshape1()
    Dim vsoShape, vsoShape2, vsoSubshape, vsoSubshapeselected As Visio.Shape
    Dim sel, sel2, sel3 As Visio.Selection
    Dim vsoMaster As Visio.Master
    Dim intVsoShape As Integer
    Dim vsoMastername As String
    Dim i As Long
    Dim validShapes As Variant
    Dim vsoCell As Visio.cell
        Set sel = Application.ActiveWindow.Selection
        sel.IterationMode = visSelModeSkipSuper 'This will disregard the group created by the selection on the window, reporting only individual shapes
        Set vsoShape = sel.PrimaryItem
        Set vsoMaster = ActiveDocument.Masters.ItemU("Master.2") 'Specify the Name of the Master target
        vsoMastername = vsoMaster.Name
        intVsoShape = 0
        validShapes = Array()         'create empty array where the master instances will be added
        '// Lets add the master's instances to a selection
        On Error GoTo ErrorMsg:
        For Each vsoShape In sel                        'For each shape selected
            If vsoShape.Master Is Nothing Then          'Disregard the shapes with no master
                Debug.Print "shapeID:", vsoShape.ID; " has no Master"
            Else
                Select Case vsoShape.Master.Name        'Separate other Master instances
                Case vsoMastername                      'The master instances we're looking for
                Debug.Print "Shape master:" & vsoShape.Master.Name
                ReDim Preserve validShapes(intVsoShape)     'Adding the master instances ID to the array "validShapes"
                validShapes(intVsoShape) = vsoShape.ID
                Debug.Print "shapeID:", vsoShape.ID & " was added to the array validShapes"   'describing the ID of the master instances
                intVsoShape = intVsoShape + 1               ' add 1 to the index
                Case Else                                   'Disregarding other masters instances shapes
                Debug.Print "shapeID:", vsoShape.ID; " is other Master instance"
                End Select
            End If
        Next
        ' Now, the shapes groups were interested are in the array "validShapes"
       
        Set sel2 = ActivePage.CreateSelection(visSelTypeEmpty)  'Create an empty selection
        For i = LBound(validShapes) To UBound(validShapes)      'To the array of Master instances ID's do:
            Debug.Print "validShapes(" & i & ") = " & validShapes(i)
            sel2.Select ActivePage.Shapes.ItemFromID(validShapes(i)), visSelect 'Select the Master 1 instance to the selection "sel2"
            ActiveWindow.DeselectAll
            Set vsoShape2 = Visio.ActivePage.Shapes.ItemFromID(validShapes(i))
            If ActivePage.Shapes.ItemFromID(validShapes(i)).Type = 2 Then 'If the Master 1 instance is a group shape (Type 2)
                For Each vsoSubshape In ActivePage.Shapes.ItemFromID(validShapes(i)).Shapes
                   Debug.Print vsoSubshape.ID, " is in ", validShapes(i)          'Describe the ID of the subshapes of every Master 1 instance
                   If vsoSubshape.CellExists("Prop.Customprop.Value", visExistsAnywhere) Then  'If the subshape has the custom Shape data cell where lookin for
                    Debug.Print vsoSubshape.ID; "has a Custom shape data"
                    Set sel3 = ActivePage.CreateSelection(visSelTypeSingle, visSelModeSkipSuper, Visio.ActivePage.Shapes.ItemFromID(vsoSubshape.ID))
                    sel3.Select ActivePage.Shapes.ItemFromID(vsoSubshape.ID), visSelect 'Add the subshape with the custom shape data cell we're looking for to the Selection "sel3"
                    Set vsoSubshapeselected = sel3.PrimaryItem
                    vsoSubshapeselected.Cells("Prop.Customprop.Value").FormulaForce = Chr(34) & Me.TextBoxSUBSHP.Value & Chr(34) 'Write the text in the userform
                    Debug.Print Me.TextBoxSUBSHP.Value & " was written in shapeID: " & vsoSubshapeselected.ID
                    Set sel3 = Nothing
                    Set vsoSubshapeselected = Nothing 'Clear selection in the loop
                   Else: End If
                Next
            Else: End If
        Next i
       
        Debug.Print "/// ITS DONE ///"
    Set sel = Nothing
    Set sel2 = Nothing
    Set vsoShape = Nothing
    Set vsoShape2 = Nothing
    Set vsoSubshape = Nothing
    Set validShapes = Nothing 'Clear objects in the UserForm instance
Exit Sub

ErrorMsg:
Debug.Print "Error #:"; Err.Source & " " & Err.Number & " Descripción: " & Err.Description

End Sub



Attached is the archive with an example. I hope somebody will find useful.