Macro that adds shape data

[Scott10284]

Throughout hundreds of different visio files I have shapes that hold data - the exact same data FIELDS (part number, manufacturer, quantity, description, and tag number).

Today we decided that we need to add another data field that references the page number that the shape resides on - no issue there.

Here lies my problem. I need to go back and add this new field to the hundreds of projects that already been executed and doing it manually for each shape is not an option because there are literally thousands of shapes that need updated with the new field.

I recorded a macro of adding the new shape data field (pasted below). I was hoping that I could then simply select shapes that do not have the new field and run the macro to add it but it does not work because the macro references the shape that I used to create it SHAPE 6336.

Is there a way that I can edit this code in a way such that the macro will apply to the shape I select before running it?

And can I run it on multiple shapes? <-- this is important.

THANKS

SCOTT

Sub PageName()

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150

    Application.ActiveWindow.Page.Shapes.ItemFromID(6336).OpenSheetWindow

    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Insert Row")
    Application.ActiveWindow.Shape.AddRow visSectionProp, 4, visTagDefault
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsValue).FormulaForceU = "0"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsPrompt).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsLabel).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsFormat).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsSortKey).FormulaForceU = """"""
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsType).FormulaForceU = "0"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsInvis).FormulaForceU = "FALSE"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsAsk).FormulaForceU = "FALSE"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsDataLinked).FormulaForceU = "FALSE"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsLangID).FormulaForceU = "1033"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsCalendar).FormulaForceU = "0"
    Application.EndUndoScope UndoScopeID1, True

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsValue).RowNameU = "PageName"

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsLabel).FormulaU = "Page Name"

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsPrompt).FormulaU = "DO NOT CHANGE"

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsFormat).FormulaU = ""

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsValue).FormulaU = "PAGENAME()"
    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsDataLinked).FormulaU = "0"

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsSortKey).FormulaU = ""

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsInvis).FormulaU = ""

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsAsk).FormulaU = ""

    Application.ActiveWindow.Shape.CellsSRC(visSectionProp, 5, visCustPropsCalendar).FormulaU = ""

    Application.ActiveWindow.Close

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

[Yacine]

This post will show you how to get a handle on each shape of your drawing: http://visguy.com/vgforum/index.php?topic=5802.msg23269#msg23269

Note! There is no need to open the shapesheet to add a custom row:

Code Select Expand

Public Function setPropRow(shp As Visio.Shape, propName As String, propLabel As String, propValue As Variant, Optional propDefaultValue As String, Optional propPrompt As String, Optional propType As Integer, Optional propFormat As String)
On Error GoTo endfunction
    ' use DefaultValue if no value has been defined
    If propValue = False Then propValue = propDefaultValue
   
    ' add the row if necessary
    Dim propRow As Integer
    If Not shp.CellExists("Prop." & propName, 0) Then
        propRow = shp.AddRow(visSectionProp, visRowLast, visTagDefault)
        shp.Section(visSectionProp).row(propRow).NameU = propName
    End If
   
    ' insert values
    shp.Cells("Prop." & propName & ".Label").FormulaForceU = """" & propLabel & """"
    shp.Cells("Prop." & propName & ".Type").FormulaForceU = propType
    shp.Cells("Prop." & propName & ".Format").FormulaForceU = """" & propFormat & """"
    shp.Cells("Prop." & propName & ".Prompt").FormulaForceU = """" & propPrompt & """"
    shp.Cells("Prop." & propName & ".Value").FormulaForceU = """" & propValue & """"
Exit Function
endfunction:
    Debug.Print "Error in setPropRow ("; shp.Name; ")"
End Function

And the most important point: Why store the page name in the shape? This is a redundant information - create it dynamically! So no need to change your thousands of shapes.