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
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.
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:
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:
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
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
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:
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:
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:
vCell.FormulaU = "=Value"
This is also not working.
How can I use the elements from the array in setting the Row Label and Value?
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
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 (https://docs.microsoft.com/en-us/office/vba/api/Visio.Cell.Formula)