Setting User Defined Cells for Masters using VBA

[Jake Stride]

Hi Folks,

I'm looking for some help. Aim is to set a few user defined cells in the visio masters based on some set in the template. I've got as var as running through the masters but can't seem to set the UDCs. Any help please (in an indeal world I'd like to check if the cell exists and just update the value, if not add cell and value)?

Code Select Expand


Sub Generate()
    Dim intCounter As Integer
    Dim intMasterCount As Integer
    Dim vsoApplication As Visio.Application
    Dim vsoCurrentDocument As Visio.Document
    Dim vsoMasters As Visio.Masters

    Set vsoApplication = GetObject(, "visio.application")
 
    If vsoApplication Is Nothing Then
        MsgBox "Microsoft Office Visio is not loaded"
        Exit Sub

    End If

    Set vsoCurrentDocument = vsoApplication.ActiveDocument

    If vsoCurrentDocument Is Nothing Then
        MsgBox "No stencil is loaded"
        Exit Sub

    End If

    Set vsoMasters = vsoCurrentDocument.Masters
    Debug.Print "Masters in document : "; vsoCurrentDocument.Name
    intMasterCount = vsoMasters.Count

    If intMasterCount > 0 Then
        For intCounter = 1 To intMasterCount
           
            Dim vsoMaster As Visio.master
            Dim vsoMasterCopy As Visio.master
            Dim vsoShapes As Visio.Shapes
            Dim vsoShape As Visio.Shape
            Set vsoMaster = vsoMasters.Item(intCounter)
            Set vsoMasterCopy = vsoMaster.Open

            MsgBox vsoMaster.Name
            'vsoMasterCopy.Shapes.Item(1).AddNamedRow visSectionUser, "test", visTagDefault
          ' vsoMasterCopy.PageSheet.AddNamedRow visSectionUser, "test", visTagDefault
'Set vsoShapes = vsoMasterCopy.Shapes
'Set vsoShape = vsoShapes("ThePage")
'vsoShape.AddNamedRow visSectionUser, "test", visTagDefault
'vsoMasterCopy.PageSheet.AddNamedRow Visio.visSectionUser, "NewUserRow", 0
   
    'set a value into the new row
    'vsoMasterCopy.PageSheet.Cells("User.NewUserRow").Formula = """some string"""
            vsoMasterCopy.Close
           
        Next intCounter
    Else
        Debug.Print " No masters in document"
    End If

   
End Sub


[Yacine]

Hi Jake,
Adding a UDC is easy - shp.addnamedrow vissectionuser, sUDCName, vistagdefault.
However, you need to check if the user section exists already.
Giving the UDC a value is similarly easy - shp.cells("user."& sUDCName).formulau = chr(34) & UDCVal & chr(34).


The proper way to modify a master is already in your code.
In the example below I did however split the problem in smaller chunks. (Kept the routine to access the masters, added a routine for modifying a master and a routine for adding a UDC).

Code Select Expand


Sub Generate()
    Dim intCounter As Integer
    Dim intMasterCount As Integer
    Dim vsoApplication As Visio.Application
    Dim vsoCurrentDocument As Visio.Document
    Dim vsoMasters As Visio.Masters

    Set vsoApplication = GetObject(, "visio.application")
 
    If vsoApplication Is Nothing Then
        MsgBox "Microsoft Office Visio is not loaded"
        Exit Sub

    End If


    Set vsoCurrentDocument = vsoApplication.ActiveDocument

    If vsoCurrentDocument Is Nothing Then
        MsgBox "No stencil is loaded"
        Exit Sub

    End If

    Set vsoMasters = vsoCurrentDocument.Masters
    Debug.Print "Masters in document : "; vsoCurrentDocument.Name
    intMasterCount = vsoMasters.Count

    If intMasterCount > 0 Then
        For intCounter = 1 To intMasterCount
           
            Dim vsoMaster As Visio.Master
            Set vsoMaster = vsoMasters.Item(intCounter)
            EditMaster vsoMaster
           
        Next intCounter
    Else
        Debug.Print " No masters in document"
    End If


   
End Sub


Sub EditMaster(ByRef mst As Master)
'http://www.visguy.com/2008/02/25/edit-visio-masters-programmaticallythe-right-way/
  Dim mstCopy As Visio.Master ' an object to hold a copy of mst...
  Dim shp As Visio.Shape


  Set mstCopy = mst.Open


    Set shp = mstCopy.Shapes(1)


    AddUDC shp, "myUDC", mst.Name
    Set shp = Nothing


    mstCopy.Close


  Set mstCopy = Nothing
  Set mst = Nothing


End Sub


Sub AddUDC(ByRef shp As Shape, UDCName As String, UDCVal)
    If Not (shp.SectionExists(visSectionUser, False)) Then
        shp.AddSection (visSectionUser)
    End If
    If Not (shp.CellExistsU("user." & UDCName, False)) Then
        shp.AddNamedRow visSectionUser, UDCName, visTagDefault
    End If
    shp.Cells("user." & UDCName).FormulaU = Chr(34) & UDCVal & Chr(34)
End Sub


HTH,
Y.

[Jake Stride]

Thanks Yancine, that works however I may have my terminology mixed up.

I want to iterate through and update the masters on the docked stencils. The code I had/was modified seems to only list the masters in the document stencil.

[Yacine]

That's right and I did actually wonder what the purpose of the exercise is.
Since I did already your home work, I'll leave up to you to find out how to access the stencils.
Hint: record a macro .