Trying to modify ShapeSheet Shape Data in vba code.

[Rich_T]

I've included Shape Data with shapes in a Visio Org Chart.
I would like to constrain the fields for data in all of the shapes on all of the pages.  I can see the shape data in the Shape Sheet:

Shape Data Section
Row Prop.JobFillStatus

As I look across the columns, I can see "Type" and "Format" fields in that row. I'd like to set the Type to 1 and the Format field to = "Open;Closed;Offer Pending" so those three items are selected.

I've got a routine that parses through each shape on each page but for the life of me I can't seem to get the Format field to take a the string. I was trying some straightforward like this with no avail.

Prop.JobFillStatus.Type = 1
Prop.JobFillStatus.Format = "Open;Closed;Offer Pending"

Can someone help?

[Surrogate]

I get this code with use macrorecorder

Code Select Expand

Sub Macro1()
    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140
    Application.ActiveWindow.Page.Shapes.ItemFromID(1).OpenSheetWindow
    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Add Section")
    Application.ActiveWindow.Shape.AddSection visSectionProp
    Application.ActiveWindow.Shape.AddRow visSectionProp, visRowLast, visTagDefault
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsValue).FormulaForceU = "0"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsPrompt).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsLabel).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsFormat).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsSortKey).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsType).FormulaForceU = "0"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsInvis).FormulaForceU = "FALSE"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsAsk).FormulaForceU = "FALSE"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsLangID).FormulaForceU = "1033"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsCalendar).FormulaForceU = "0"
    Application.EndUndoScope UndoScopeID1, True
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsValue).RowNameU = "JobFillStatus"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsType).FormulaU = "1"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 0, visCustPropsFormat).FormulaU = """Open;Closed;Offer Pending"""
    Application.ActiveWindow.Close
    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices
End Sub

Just modify this code and you can add this shape data to some selected shapes

Code Select Expand

Sub Add_PropJobFillStatus()
Dim sh As Shape
For Each sh In ActiveWindow.Selection ' itterate selected shapes
    sh.AddSection visSectionProp
    sh.AddRow visSectionProp, visRowLast, visTagDefault
    sh.CellsSRC(visSectionProp, 0, visCustPropsValue).FormulaForceU = "0"
    sh.CellsSRC(visSectionProp, 0, visCustPropsPrompt).FormulaForceU = """"""
    sh.CellsSRC(visSectionProp, 0, visCustPropsLabel).FormulaForceU = """"""
    sh.CellsSRC(visSectionProp, 0, visCustPropsFormat).FormulaForceU = """"""
    sh.CellsSRC(visSectionProp, 0, visCustPropsSortKey).FormulaForceU = """"""
    sh.CellsSRC(visSectionProp, 0, visCustPropsType).FormulaForceU = "0"
    sh.CellsSRC(visSectionProp, 0, visCustPropsInvis).FormulaForceU = "FALSE"
    sh.CellsSRC(visSectionProp, 0, visCustPropsAsk).FormulaForceU = "FALSE"
    sh.CellsSRC(visSectionProp, 0, visCustPropsLangID).FormulaForceU = "1033"
    sh.CellsSRC(visSectionProp, 0, visCustPropsCalendar).FormulaForceU = "0"
    sh.CellsSRC(visSectionProp, 0, visCustPropsValue).RowNameU = "JobFillStatus"
    sh.CellsSRC(visSectionProp, 0, visCustPropsType).FormulaU = "1"
    sh.CellsSRC(visSectionProp, 0, visCustPropsFormat).FormulaU = """Open;Closed;Offer Pending"""
Next
End Sub

[JohnGoldsmith]

The Formula/U property of the cell object takes a string expression, but a number of formulae are expressed as a string using double quotes, so these need to be included as per @surrogate's code.  Visio interprets two consecutive double quotes as a literal and so it gets included in the resulting formula.

Have a look at 'Working with formulas in cells' from Developing Visio Solutions for more details.

Best regards

John

[Rich_T]

JohnGoldsmith and Surrogate - Thank you very, very much.  The triple quotes was the trick that I was missing!