Changing Organisation Chart Position Type via VBA

[dmtelf]

I've got an organisation chart in Visio 2013 & need to change the Position Type of all Manager shapes to Vacancy on all pages.

I found some short VBA code that does this, but it was written for Visio 2003 & I'm getting 1 error with it in Visio 2013 - "Run-time error '-2032466967 (86db03e9)': Unexpected end of file" which happens at the "Set vsoCell = vsoShape.Cells("User.ShapeType")" line.

Can anyone please advise how to fix this?

Sub UpdatePositionType()

OrgChart_ChangePositionType 1, 4

End Sub

Sub OrgChart_ChangePositionType(intShapeNumber As Integer, intPositionType As Integer)
' Accesses User-defined Cells for the shape
' Org Chart Shapes Position Types:
' Executive = 0
' Manager = 1
' Position = 2
' Consultant = 3
' Vacancy = 4
' Assistant = 5
' Staff = 6

Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim vsoCell As Visio.Cell
Dim intCounter As Integer

Set vsoPage = ActivePage

'If there isn't an active page, set vsoPage
'to the first page of the active document.
If vsoPage Is Nothing Then
Set vsoPage = ActiveDocument.Pages(1)
End If

'Set the vsoShape to the desired shape (1 thru Visio.ActivePage.Shapes.Count)
'vsoPage.Shapes(1) is the first or topmost org chart shape
Set vsoShape = vsoPage.Shapes(intShapeNumber)

'Set vsoCell to the desired user-defined cell and set its formula.
Set vsoCell = vsoShape.Cells("User.ShapeType")
vsoCell.Formula = intPositionType

End Sub

Thanks.

DMtelf

[Paul Herber]

I don't have Visio 2013 so can't help 100%, but, Org Charts changed completely in Visio 2013 so the shapes may be totally different.
Try this, create a new Org Chart, drop a Manager shape on the chart then open up the shape sheet for that shape (Developer -> Show Shapesheet) and see if there is a cell called ShapeType in the User-Defined Cells section. If not then your code won't work.
But, when you right-click on the Manager shape is there an option "Change Position Type" or similar? If so then the next step is to work out what gets changed in the shapesheet when this menu is used, then replicate that in code.

[JohnGoldsmith]

Do you also want to remove the existing data or just change the position type?

Best regards

John

[dmtelf]

Do you also want to remove the existing data or just change the position type?

I want to change the position type & need to keep the existing data.

Thanks.

DMTelf

[aledlund]

have you had a chance to review this one?
http://blogs.office.com/b/visio/archive/2012/10/10/insights-for-developers-about-change-shape.aspx

al

[JohnGoldsmith]

If you're not wanting to change the Org Chart Style, just it's position type, then your code below should work.  You're effectively just changing the Shape Type cell.  I would get that the problem you're hitting is that you're getting hold of a non-position (ie not 'Executive', 'Manager', 'Position', 'Assistant', 'Consultant' or 'Vacancy') shape and the code's not checking for the cell's existence before it tries to reference it.

Here's an adapted example that loops through all of the shapes in each page of the document.  It's looking for a target position shape who's type is 1 (manager) and changes it to a new type, 4 (Vacancy).  You can edit the code in the first procedure to change the scope or add other criteria as required.  The code should be good for previous versions of Visio, although I haven't tested it.

If you want to change the style as well (or instead of) then you'll need to look at Al's link below as that how Visio 2013 now handles changing org chart shape styles.

Let me know how you get on.

Best regards

John

Code Select Expand

Const SHP_TYPE_CELL = "User.ShapeType"

Sub UpdatePositionType()
' Org Chart Shapes Position Types:
' Executive = 0
' Manager = 1
' Position = 2
' Consultant = 3
' Vacancy = 4
' Assistant = 5
' Staff = 6
Dim vDoc As Document
Set vDoc = ActiveDocument

Dim vPag As Page
For Each vPag In vDoc.Pages
    If vPag.Background = False Then
        Dim vShp As Shape
        For Each vShp In vPag.Shapes
            ChangeOrgChartPositionType vShp, 1, 4
        Next vShp
    End If
Next vPag
End Sub

Private Sub ChangeOrgChartPositionType(ByRef vShp As Shape, iTargetPosition As Integer, iNewPositionType As Integer)
If iNewPositionType >= 0 And iNewPositionType <= 6 Then
    If Not vShp Is Nothing Then
        If IsOrgChartPositionShp(vShp) Then
            If vShp.CellExistsU(SHP_TYPE_CELL, 0) Then
                If vShp.CellsU(SHP_TYPE_CELL).ResultStrU(VisUnitCodes.visNumber) = iTargetPosition Then
                    vShp.CellsU(SHP_TYPE_CELL).FormulaU = iNewPositionType
                End If
            End If
        End If
    End If
End If
End Sub

Private Function IsOrgChartPositionShp(ByRef vShpIn As Visio.Shape) As Boolean
Dim IsPositionType As Boolean
If Not vShpIn Is Nothing Then
    If Not vShpIn.Master Is Nothing Then
        If vShpIn.CellExistsU(SHP_TYPE_CELL, 0) Then
            Dim mstName As String
            mstName = vShpIn.Master.NameU
            Dim MstNames As Variant
            Dim i As Integer
            MstNames = Array("Executive", "Manager", "Position", "Assistant", "Consultant", "Vacancy")
            For i = LBound(MstNames) To UBound(MstNames)
                If Left(mstName, Len(MstNames(i))) = MstNames(i) Then
                    IsPositionType = True
                    Exit For
                End If
            Next i
        End If
    End If
End If

IsOrgChartPositionShp = IsPositionType

End Function

[JohnGoldsmith]

...and here's a linked question over on the TechNet forum:

http://social.msdn.microsoft.com/Forums/en-US/visiogeneral/thread/f0e1b7c3-6ee9-484b-bf53-65f3c689eeb1

Just to be clear, the master naming appears to be consistent across the different org chart styles:

"[CommonMstName] [OrgChartStyleName]"

hence the IsOrgChartPositionShp function in the code below tests the left part of the master nameU against the list of targets and so it should also work for previous versions.

[dmtelf]

Many thanks, John!!  Your code worked *perfectly*.  It does exactly what I required, and the 3 functions are very useful for me as a newbie to learn from & build on.  Thank you!  This code can also be used as a framework for other Org Chart manipulation to any/all Position shapes.

I've now been asked to take what I'm developing a step further by making it possible to replace the contents of the Name & Title field in a chosen position type across all pages.

I took your function, changed the name of the ChangeOrgChartPositionType function to ManipulateOrgShapeText & wrote some [psuedo]code & comments.  This function would be called in exactly the same way it currently is in your original code.

The 3 lines ending with [HELP] are where I would really appreciate some help!  One issue is I haven't yet been able to work out yet how to get/set the contents of a shape's property e.g. the Title or Name fields or from within the innermost ManipulateOrgShapeText code.

Another is to split the contents of the title/name field which is a string e.g. hello[there] & either return hello or there.  I think it might be possible to do this using MID or RIGHT with an inline LEFT to find the numeric position of the [ delimiter?

I've attached a sample diagram which has the below code.

Code Select Expand


' Code originally by John Goldsmith, Visio Guy forum
' http://visguy.com/vgforum/index.php?topic=4760.0

Const SHP_TYPE_CELL = "User.ShapeType"

Sub TweakOrgShapeText()
' Org Chart Shapes Position Types:
' Executive = 0
' Manager = 1
' Position = 2
' Consultant = 3
' Vacancy = 4
' Assistant = 5
' Staff = 6
Dim vDoc As Document
Set vDoc = ActiveDocument

Dim vPag As Page
For Each vPag In vDoc.Pages
    If vPag.Background = False Then
        Dim vShp As Shape
        For Each vShp In vPag.Shapes
            ManipulateOrgShapeText vShp, 0
        Next vShp
    End If
Next vPag
End Sub

Private Sub ManipulateOrgShapeText(ByRef vShp As Shape, iTargetPosition As Integer)
If iNewPositionType >= 0 And iNewPositionType <= 6 Then
    If Not vShp Is Nothing Then
        If IsOrgChartPositionShp(vShp) Then
'           If vShp.CellExistsU(SHP_TYPE_CELL, 0) Then
'                If vShp.CellsU(SHP_TYPE_CELL).ResultStrU(VisUnitCodes.visNumber) = iTargetPosition Then
'                   ' TitleString = Get title field content from shape (HELP)
'                   ' Check contents of TitleString to see if it needs changing.  It should be string1[string2] e.g. hello[there]
'                   If TitleString = "*[*]"
'                       Get left hand part of string before [] e.g. string1 e.g. hello (HELP)
'                       TitleString = SplitField(TitleString, 0)
'                       ' Replace title field content with TitleString which is string1 e.g. hello
'                       TitleString = string1 (HELP)
'                   End If
               
'                   ' NameString = Get title field content from shape (HELP)
'                   ' Check formatting of NameString to see if it needs changing.  It should be string1[string2] e.g. hello[there]
'                   If NameString = "*[*]"
'                       Get right hand part of string inbetween [] e.g. string2 e.g. there (HELP)
'                       NameString = SplitField(NameString, 1)
'                       ' Replace name field content with NameString which is string2 e.g. there
'                       NameString = string2  (HELP)
'                   End If
'                End If
'            End If
        End If
    End If
End If
End Sub

Private Function SplitField(ByRef FieldContents As String, FieldToSplit As Integer)

' if FieldToSplit = 0, return left hand side of FieldContents string
' if FieldToSplit = 1, return right hand side of FieldContents string

' if FieldContents = "hello[there]", 0 returns hello, 1 returns there

End Function

Private Function IsOrgChartPositionShp(ByRef vShpIn As Visio.Shape) As Boolean
Dim IsPositionType As Boolean
If Not vShpIn Is Nothing Then
    If Not vShpIn.Master Is Nothing Then
        If vShpIn.CellExistsU(SHP_TYPE_CELL, 0) Then
            Dim mstName As String
            mstName = vShpIn.Master.NameU
            Dim MstNames As Variant
            Dim i As Integer
            MstNames = Array("Executive", "Manager", "Position", "Assistant", "Consultant", "Vacancy")
            For i = LBound(MstNames) To UBound(MstNames)
                If Left(mstName, Len(MstNames(i))) = MstNames(i) Then
                    IsPositionType = True
                    Exit For
                End If
            Next i
        End If
    End If
End If

IsOrgChartPositionShp = IsPositionType

End Function


[JohnGoldsmith]

Hi,

I'm not sure I'm absolutely clear on what you're trying to achieve.  If you want to replace the Name and Title fields (which are fields surfaced from Shape Data) then I would have thought the best place to do this is in your data (ie Excel or other data source that you populated your org chart from.  Is that not an option in this case?

To get hold of the Title or Name Shape Data you just access this from the appropriate cell (see image below).  For example, for the Name Shape Data row:

Dim strTheNameStringValue As String
strTheNameStringValue = vShp.CellsU("Prop.Name").ResultStrU("")

You might want to check out this link for more information about accessing ShapeSheet cells in VBA:

http://msdn.microsoft.com/en-us/library/aa201764%28v=office.10%29.aspx

For the split string problem, I would try and avoid concatenting the data and do this in the shape, so, in your example, you would have two Shape Data properties, one hold "hello" and the other holding "there".  You could then have another property concatenate the two and reference that new property in a shape field.

Prop.FirstPart = "hello"
Prop.SecondPart = "there"
Prop.Together = Prop.FirstPart&"["&Prop.SecondPart&"]"

If you want to look at the Split function then have a look at the docs here:

http://msdn.microsoft.com/en-us/library/gg278528%28v=office.14%29.aspx

Also for more generic string comparison, you might want to read through this link as well:

http://www.databison.com/index.php/string-comparison-function-in-vba/

Hope that helps.

Best regards

John