Writing to ShapeSheet cells not working?

[danielj]

I'm having an issue with changing the ShapeSheet cells in a master shape via VBA.

Here's the structure of my master shape.  I'm trying to change the values of User.Row_1 in each of the Port_TR/TC/TL objects:


Here's the ShapeSheet for the Port object.  I have two of the fields linked to the User.Row_1 cell, so that when I change it to TRUE, the object becomes invisible.  Manually changing the value to TRUE makes the object disappear, as expected.



Here's my VBA code - I find the right shape by name (works fine), check if the cell exists (seems to work fine - it passes the IF statement, and the .Formula line executes without error (if I change the value I'm trying to write from TRUE or FALSE to some gibberish, it gives an error).  However, after running the code, the value in the user cell doesn't change.

[Surrogate]

Please try wrap with quotes CHR(34).

Code Select Expand

= Chr(34)&portHideFormula&Chr(34)

[danielj]

Earlier in the code I have:

Code Select Expand

If portHide Then
        portHideFormula = Chr(34) & "True" & Chr(34)
    Else
        portHideFormula = Chr(34) & "False" & Chr(34)
    End If
End If
With or without the Chr(34), it's the same result.

Here's the full code for the function:

Code Select Expand

Sub ChangePortVis(portName As String, portHide As Boolean)

    Dim portHideFormula As String
    If portHide Then
        portHideFormula = Chr(34) & "TRUE" & Chr(34)
    Else
        portHideFormula = Chr(34) & "FALSE" & Chr(34)
    End If

   
    'find the master shape where the ports live
    Dim masterShape As Shape
    For Each m In ThisDocument.Masters
        'Debug.Print (m.Name)
        If m.Name = "xDeviceTemplate_layer2" Then
            If m.Shapes.Item(1).Name = "GroupedShapeForRightClickCustomCmd" Then
                Debug.Print ("Found grouped object: " & m.Shapes.Item(1).Name)
                Set masterShape = m.Shapes.Item(1)
                Exit For
            End If
           
        End If
    Next
   
   
    'scan through shapes, look for match by name, then set the user formula that hides the port object
    For Each shp In masterShape.Shapes
        shpName = shp.Name
        If shpName = portName Then
            userCellName = "User.Row_1"
            userCellExists = shp.CellExists(userCellName, 1)

            If userCellExists Then
                Debug.Print ("Found port, changing visibility to " & portHideFormula & " for " & shpName)
                shp.Cells(userCellName).Formula = portHideFormula
                Exit For
            End If
        End If
    Next
   
End Sub


[Surrogate]

Here's the structure of my master shape.

When you try change shapes into master, you must update its master!

[danielj]

Not sure what you mean - can you be a bit more explicit?  The Port_TL and others are all instances of the Port master shape, which already has the NoLine and HideText fields set as shown above.  I want to be able to write to the User.Row_1 cell for each of the instances and set it to TRUE or FALSE as needed, so that depending on what arguments I pass to the function, none/some/all of the port shapes show.

[wapperdude]

Some debugging ideas...
1) Step thru the code line by line using <F8>.  After a line executes, hover mouse over a variable and check it for expected value.
2) alternatively, add more debug prints to see what goes on within your code...in addition to the debug prints you already have.
3) have 2 windows open, tiled side by side.  One is drawing window the other the code window.  In the drawing window show both a subshapes of interest and its shapesheet.  Make sure the drawing page is selected not the shapesheet.  As you step thru code, you should see desired shapesheet cell get populated.

[danielj]

I'm getting the feeling that there are legacy object names that are hanging around in the file, even though I've deleted the objects.  Is there a way to clean out unused references?

[wapperdude]

Do you mean shapes?  Or perhaps more specifically, masters?  It is possible that there are unused masters on the Doc stencil.  But aside from a little clutter, those should not interfere with the code operation.

Did you do any of the troubleshooting steps? 

Anyway, here are some links to clean things up.
  >> Remove Unused Masters

  >> https://bvisual.net/2015/01/07/cleaning-visio-documents/#:~:text=Of%20course%2C%20the%20document%20must,stencil%20from%20here:%20Cleaner.vss

  >> https://support.microsoft.com/en-us/office/reduce-the-size-of-a-visio-file-5f7af540-4fb8-4ec7-80a2-92bd7749e714

[Surrogate]

At my side this code works!

Code Select Expand

Sub TEST()
Dim doc As Document
Dim wd As Window ' active document window
Dim we As Window ' 1st master's window (external)
Dim wi As Window ' 2nd master's window (internal)
Dim userCellName As String
Dim userCellExist As Boolean
Dim portHideFormula As String
portHideFormula = True ' TRUE or FALSE
userCellName = "user.blahblah"
Dim masterShape As Shape
    Set doc = ActiveDocument
    Set wd = doc.Application.Window '
    Set we = doc.Masters.Item(1).Open.OpenDrawWindow
    we.Activate
    Set masterShape = we.Master.Shapes.Item(1)
    Set wi = masterShape.OpenDrawWindow

    wi.Activate
   
    For Each SHP In masterShape.Shapes
        userCellExist = SHP.CellExists(userCellName, visExistsAnywhere)
        If userCellExist Then
            Debug.Print "Found port:" & SHP.Name
            SHP.Cells(userCellName).Formula = portHideFormula
        End If
    Next
    wi.Activate
    wi.Close
    we.Master.Close
    wd.Activate
    Application.ActiveWindow.WindowState = visWSMaximized
End SubPlease try my attachment...

[danielj]

I was never able to get this working using .Cell and .Formula, but when I changed to CellSRC and read/write by using the indexes, it works as expected.  Thank you for all of the help!

Code Select Expand

For Each port In portGroup.Shapes
        'If Left(port.Name, Len("xDeviceTemplatePort")) = "xDeviceTemplatePort" Then
        If port = "xDeviceTemplatePort." & portName Then
            Debug.Print ("Found a port: " & port.Name)
            nRows = port.RowCount(Visio.visSectionUser) 'get the number of rows in the User section
            Set celObj = port.CellsSRC(Visio.visSectionUser, i, 0) 'get the cell objext for the first entry
            celObj.Formula = portHideFormula
        End If
       
Next

[wapperdude]

Hmmmm.  Using .cells and .formula are two common syntax elements.  Bread and butter items for VBA.  The .cells expects precise reference.  The .formula is the normal way of placing content into a cell. See these references:
  > https://learn.microsoft.com/en-us/office/vba/api/visio.shape.cells

  > https://learn.microsoft.com/en-us/office/vba/api/visio.cell.formula

I realize that the party is over, and most everyone has left.  But for those awakening with a hangover, here is an alternative syntax to identify a specific master, and then make changes to subshapes.  It is based upon Surrogate's previous post.  Indeed, it re-uses his Test file with some additions.  Nothing like being lazy, and I own up to it.

Here's the code and attached file:

Code Select Expand

Sub TEST()
    Dim userCellName As String
    Dim userCellExist As Boolean
    Dim portHideFormula As Boolean
    Dim mstrName As String
    Dim prtA As String
    Dim prtB As String
   
'Variable value initializations:  set before running macro
    mstrName = "MyMstr"                     'Name of desired master dropped from a stencil
    userCellName = "user.blahblah"          'defines User visibility cell
    portHideFormula = True                  'sets visibility value prior to running macro
    prtA = "P1"
    prtB = "P2"
   
    For Each mShp In ActivePage.Shapes      'Checks all shapes on active page
        Set iamMstr = mShp.Master           'Checks if shape has master
        If Not (iamMstr Is Nothing) Then    'Value is nothing if there is no master
            If iamMstr.Name = mstrName Then 'Name of desired Master shape. Syntax may need to use string compare here
                Debug.Print mShp.Name
                Debug.Print mShp.Shapes.Count
               
                For Each vShp In mShp.Shapes    'steps thru each subshape in the master.
                    Debug.Print vShp.Name
                    userCellExist = vShp.CellExists(userCellName, visExistsAnywhere)
                    If vShp.Name = prtA Then    'Name of desired subshape. Syntax may need to use string compare syntax here
                        If userCellExist Then
                            Debug.Print "Found port:" & vShp.Name
                            vShp.Cells(userCellName).Formula = Not (vShp.Cells(userCellName).ResultStr(Visio.visNone)) 'this toggles the visibility
                        End If
                    ElseIf vShp.Name = prtB Then    'Name of desired subshape. Syntax may need to use string compare here
                        If userCellExist Then
                            Debug.Print "Found port:" & vShp.Name
                            vShp.Cells(userCellName).Formula = portHideFormula  'this hard sets the visibility
                        End If
                    End If
                Next
            End If
        End If
    Next
End Sub