ShapeData: How to avoid list reset after modification

[Bogey]

Hello,

I am creating a Drawing in Visio which will periodically be updated with new shapes and shape data. I have defined a Data Set that I apply to every new Master Shape I create. The Data Set contains a few lists, which I will need to update, from time to time. However, if I do this, all the existing shapes in the drawing will have the respective field reset and I need to reselect an item from the list for every shape. As the drawing is getting larger and larger, this is becoming annoying. Is there any way I could create a list insert new items in it, without my current shapes losing information?

Thanks,
Bogey

[wapperdude]

This probably requires VBA...
OPTIONS:
1) search each shape for existence of data field and ignore updating that field
or
2) search each shape and copy existing fields to temp storage, update, then recall existing temp storage.

You can try using macro recorder to capture your steps, but I suspect this won't be too useful in this endeavor.

[Bogey]

I'm not very good with VBA, but I've tried adding a temporary container, to copy the data from the List and store it until I update the values. This is what I got so far:

Code: [Select]

Sub AddRow()
    Dim vPage As Visio.Page
    Dim vShape As Shape
    Dim vRowInt As Integer
   
    Set vPage = ActiveDocument.Pages(1)
       
    For Each vShape In vPage.Shapes
        If Not vShape.SectionExists(visSectionProp, 0) Then
            vShape.AddSection (visSectionProp)
        End If
        vRowInt = vShape.AddRow(visSectionProp, visRowLast, visTagDefault)
        vShape.Section(visSectionProp).Row(vRowInt).NameU = "Temp"
        vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsLabel).FormulaU = """Temp"""
        vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsType).FormulaU = 0
        vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsFormat).FormulaU = ""
        vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsValue).FormulaU = *Prop.List.Value*
       
    Next
       
End Sub
Let's say I have two rows in the Shape Data Section: List and Temp (which I just created). *Prop.List.Value* is what I would like to insert in the Temp Value, but I couldn't figure out the correct syntax. How could I identify the right Cell from the Row Name or Label so I can retrieve it's Value?

Edit:

Ok, so I've finally obtained something that works:

Code: [Select]

Sub AddTemp()
    Dim vPage As Visio.Page
    Dim vShape As Shape
    Dim vRowInt As Integer
    Dim vCell As Cell
   
    Set vPage = ActiveDocument.Pages(1)
       
    For Each vShape In vPage.Shapes
        If Not vShape.SectionExists(visSectionProp, 0) Then
            vShape.AddSection (visSectionProp)
        End If
        If Not vShape.CellExistsU("Prop.Temp", 1) Then
            vRowInt = vShape.AddRow(visSectionProp, visRowLast, visTagDefault)
            vShape.Section(visSectionProp).Row(vRowInt).NameU = "Temp"
            vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsLabel).FormulaU = """Temp"""
            vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsType).FormulaU = 0
            vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsFormat).FormulaU = ""
            If vShape.CellExistsU("Prop.LIST", 1) Then
                Set vCell = vShape.CellsU("Prop.Temp.Value")
                vCell.FormulaU = "Prop.LIST.Value"
            End If
        End If
    Next
    MsgBox "Temporary Storage Created"
       
End Sub

Code: [Select]

Sub RemoveTemp()
    Dim vPage As Visio.Page
    Dim vShape As Shape
   
    Set vPage = ActiveDocument.Pages(1)
   
    For Each vShape In vPage.Shapes
        If vShape.CellExistsU("Prop.Temp", 1) Then
            Dim vCell As Cell
            Set vCell = vShape.CellsU("Prop.Temp")
            vShape.DeleteRow visSectionProp, vCell.Row
        End If
    Next
    MsgBox "Temporary Storage Cleaned"
End Sub

[Bogey]

I want to modify the previous functions to work with my Drawing. Let's assume that all my shapes have List1 and List2 as Shape Data. I create an array containing the names of these lists as strings and use it to iterate through all the lists I want:

Code: [Select]

Sub AddTemp()
    Dim vPage As Visio.Page
    Dim vShape As Shape
    Dim vRowInt As Integer
    Dim vCell As Cell
    Dim MyList As Variant
    Dim Value As String
   
    'Shape Data defined as Fixed/Variable List:
    MyList = Array("List1", "List2")
   
    'Loop through each page of the document
    For Each vPage In ThisDocument.Pages
    'Loop through each shape of each page of the document
        For Each vShape In vPage.Shapes
    'If ShapeData does not exist, create it
            If vShape.SectionExists(visSectionProp, 0) Then
                For Each element In MyList
                    If Not vShape.CellExistsU("Prop." + element + "Temp", 1) Then
                        vRowInt = vShape.AddRow(visSectionProp, visRowLast, visTagDefault)
                        vShape.Section(visSectionProp).Row(vRowInt).NameU = element + "Temp"
                        vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsLabel).FormulaU = element
                        vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsType).FormulaU = 0
                        vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsFormat).FormulaU = ""
                        If vShape.CellExistsU("Prop." + element, 1) Then
                            Set vCell = vShape.CellsU("Prop." + element + ".Value")
                            Value = vCell.ResultStrU(Visio.visNone)
                            'MsgBox Value
                            Set vCell = vShape.CellsU("Prop." + element + "Temp.Value")
                            vCell.FormulaU = "=Value"
                        End If
                    End If
                Next
            End If
        Next
    Next
    MsgBox "Temporary Storage Created"
       
End Sub
I am encountering the following issue:

• I would like to set the Label of the rows I add in function of my array elements:

Code: [Select]

vShape.CellsSRC(visSectionProp, vRowInt, visCustPropsLabel).FormulaU = element
This code doesn't work, though.

I have also tried another approach, for example in setting the value of the same row:

Code: [Select]

vCell.FormulaU = "=Value"
This is also not working.

How can I use the elements from the array in setting the Row Label and Value?

[wapperdude]

To create or to change a row name, use the following syntax.  Note, "shape" should be the actual shape in question, e.g., sheet.1

Code: [Select]

    If Not shape.CellExistsU("User.CusTxt", False) Then
        shape.AddNamedRow visSectionUser, "CusTxt", visdefault
        shape.CellsU("User.CusTxt").FormulaU = ""                                           'Placed within so doesn't overwrite
    End If

   
    Shape.CellsSRC(visSectionUser, 0, visUserValue).RowNameU = "MyName"


One example (method) to assign an entry to a cell is:  shape.CellsU("User.NormTxt").FormulaU =  something

See:
https://docs.microsoft.com/en-us/office/vba/api/Visio.Cell.Formula