Conditional formatting

[Andy_E]

Hi all,

I'm new to visio but need to learn quickly - in the new year I need to create lots of org charts fairly quickly from excel data. I've prepared the excel data and can get the org charts drawn from the wizzard but I need to colour code each position.

Example excel data attached to ilustrate:

Fill colour - to represent function

Outline colour - to represent team

I've tried a few formulas in ShapeSheet but can't get it to work and help would be greatly appreciated

Andy

[joemako]

your mileage may vary with this, but you can try something like this:

Code

Sub SetLineAndFill()

    Dim strTeam As String
    Dim strFunction As String

    Dim shp As Visio.Shape

    For Each shp In Application.ActiveWindow.Page.Shapes

        If shp.Type = 2 Then
            'this is a group shape

            'get team and function values and strip off quotes
            strTeam = shp.Cells("Prop.Team.Value").Formula
            strFunction = shp.Cells("Prop.Function.Value").Formula
            
            strTeam = Mid(strTeam, 2, Len(strTeam) - 2)
            strFunction = Mid(strFunction, 2, Len(strFunction) - 2)
            
            
            Select Case strTeam
                Case "A"
                    shp.Cells("LineColor") = "2" 'Red
                Case "B"
                    shp.Cells("LineColor") = "3" 'Green
                Case "X"
                    shp.Cells("LineColor") = "4" 'Blue
                Case Else
                    'Do Nothing
            End Select
            
            Select Case strFunction
                Case "Management"
                    shp.Cells("FillForegnd") = "2" 'Red
                Case "Supervisor"
                    shp.Cells("FillForegnd") = "3" 'Green
                Case "Worker"
                    shp.Cells("FillForegnd") = "4" 'Blue
                Case "Admin"
                    shp.Cells("FillForegnd") = "5" 'Yellow
                Case "Data processor"
                    shp.Cells("FillForegnd") = "6" 'Pink
                Case Else
                    'Do Nothing
            End Select
            
        End If

    Next

End Sub