Everyone knows that you can change the colour of Visio shapes. Most people know that you can also change the fill pattern too.
The Fill dialog displays these bits of information as Color, Pattern and Pattern color. However, the ShapeSheet stores them as FillForegnd, FillPattern and FillBkgnd. The following screenshot is displaying the Values of the cells, which displays the RGB values:
The actual formula for a colour though, may reference a particular theme, or it could be a number from the color map, for example 2 usually means Red (or RGB(255,0,0)).
Some Visio users may wish to display the RGB values in Shape Data rows so that these values can be analysed or reported.
So, I have added some code to the bVisualUtilities.vss that I started in my last blog about automatically updating Shape Data with Area and Perimeter Lengths
First. I added some constants to the bVisualMetrics module:
Option Explicit
Const actionUpdateCell As String = "Actions.UpdateMetrics"
Const fillForegndCell As String = "Prop.FillForegnd"
Const fillBkgndCell As String = "Prop.FillBkgnd"
Const fillPatternCell As String = "Prop.FillPattern"
Then, I added the AddUpdateFillsTrigger() to add some cells to the Page and selected shapes.
Public Sub AddUpdateFillsTrigger()
Dim shp As Visio.Shape
Dim iSect As Integer
Dim iRow As Integer
Dim pag As Visio.Shape
For Each shp In Visio.ActiveWindow.Selection
If Not shp.ContainingMaster Is Nothing Then
Set pag = shp.ContainingMaster.PageSheet
ElseIf Not shp.ContainingPage Is Nothing Then
Set pag = shp.ContainingPage.PageSheet
End If
iSect = Visio.VisSectionIndices.visSectionAction
If pag.SectionExists(iSect, Visio.VisExistsFlags.visExistsAnywhere) = 0 Then
pag.AddSection iSect
End If
If pag.CellExists(actionUpdateCell, Visio.visExistsAnywhere) = 0 Then
iRow = pag.AddNamedRow(iSect, Split(actionUpdateCell, ".")(1), 0)
pag.CellsSRC(iSect, iRow, Visio.VisCellIndices.visActionAction).FormulaU = _
"=SETF(GetRef(Actions.UpdateMetrics.Checked)," & _
"NOT(Actions.UpdateMetrics.Checked))"
pag.CellsSRC(iSect, iRow, Visio.VisCellIndices.visActionMenu).FormulaU = _
"=""Refresh Metrics"""
End If
iSect = Visio.VisSectionIndices.visSectionUser
If shp.SectionExists(iSect, Visio.VisExistsFlags.visExistsAnywhere) = 0 Then
shp.AddSection iSect
End If
If shp.CellExists("User.UpdateFillsTrigger", Visio.visExistsAnywhere) = 0 Then
iRow = shp.AddNamedRow(iSect, "UpdateFillsTrigger", 0)
shp.Cells("User.UpdateFillsTrigger").FormulaU = _
"=DEPENDSON(FillForegnd,FillBkgnd,FillPattern,ThePage!" & _
actionUpdateCell & ".Checked) + " & _
"CALLTHIS(""UpdateFills"",""bVisualUtilities"")"
End If
iSect = Visio.VisSectionIndices.visSectionProp
If shp.CellExists(fillForegndCell, Visio.visExistsAnywhere) = 0 Then
iRow = shp.AddNamedRow(iSect, Split(fillForegndCell, ".")(1), 0)
shp.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsLabel).FormulaU = _
"=""Foreground"""
shp.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsType).FormulaU = _
"=0"
End If
If shp.CellExists(fillBkgndCell, Visio.visExistsAnywhere) = 0 Then
iRow = shp.AddNamedRow(iSect, Split(fillBkgndCell, ".")(1), 0)
shp.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsLabel).FormulaU = _
"=""Background"""
shp.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsType).FormulaU = _
"=0"
End If
If shp.CellExists(fillPatternCell, Visio.visExistsAnywhere) = 0 Then
iRow = shp.AddNamedRow(iSect, Split(fillPatternCell, ".")(1), 0)
shp.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsLabel).FormulaU = _
"=""Pattern"""
shp.CellsSRC(iSect, iRow, Visio.VisCellIndices.visCustPropsType).FormulaU = _
"=0"
End If
UpdateFills shp
Next
End Sub
Finally, I added the UpdateFills() method that actually updates the Shape Data in the shapes whenever the FillForegnd, FillPattern or FillBkgnd values are changed.
Public Sub UpdateFills(ByVal shp As Visio.Shape)
Dim iSect As Integer
Dim iRow As Integer
Dim pag As Visio.Shape
If Not shp.ContainingMaster Is Nothing Then
Set pag = shp.ContainingMaster.PageSheet
ElseIf Not shp.ContainingPage Is Nothing Then
Set pag = shp.ContainingPage.PageSheet
End If
If pag Is Nothing Then
Exit Sub
End If
iSect = Visio.VisSectionIndices.visSectionProp
If UCase(Left(fillForegndCell, 5)) = "PROP." Or UCase(Left(fillBkgndCell, 5)) = "PROP." Or _
UCase(Left(fillPatternCell, 5)) = "PROP." Then
If shp.SectionExists(iSect, Visio.VisExistsFlags.visExistsAnywhere) = 0 Then
shp.AddSection iSect
End If
Else
Exit Sub
End If
If shp.CellExists(fillForegndCell, Visio.visExistsAnywhere) Then
shp.Cells(fillForegndCell).FormulaU = "=""" & shp.Cells("FillForegnd").ResultStr("") & """"
End If
If shp.CellExists(fillBkgndCell, Visio.visExistsAnywhere) Then
shp.Cells(fillBkgndCell).FormulaU = "=""" & shp.Cells("FillBkgnd").ResultStr("") & """"
End If
If shp.CellExists(fillPatternCell, Visio.visExistsAnywhere) Then
shp.Cells(fillPatternCell).FormulaU = "=""" & Replace(shp.Cells("FillPattern").FormulaU, """", """""") & """"
End If
End Sub
You can download the stencil that contains the VBA code here : http://bit.ly/cJYwdP
So, to use this, just Run the AddUpdateFillsTrigger macro whilst your desired shapes are selected.
This macro will three Shape Data rows to the selected shapes, which will display the RGB values of the Foreground and Background, plus the formula of the Pattern.
It is then a simple matter of using Data Graphics, as I showed in the earlier blog article, or Insert Field, as shown below, to display the Shape Data row values in the shape (don’t forget that you can enter text, field values and multiple rows in a text block):
Once this has been done to a ew shapes, then you easily use the built-in Visio reporting tool to list the shapes and their fills:
Not long now to the release of Visio 2010, but all of the code in this blog will work on any version and edition that I can think of.