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:
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.
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:
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.