Data Graphics - Data Bar Max - Min Values

[Confused Duncan]

Is it possible to set the maximum and minimum values on a Data Bar to values
in a database rather than individually entering each max and min value?

 

[JuneTheSecond]

You might need to make use of shape data on the graphic icons.
The icon of data bar has invisible shape data, max and min.

 

[David Parker]

This is something that I will explaining at he Conference next week...
Basically, you have to check the actual values of the shape cells because a
DatGraphic does not need to refer to a database, or to a singlle column in a
database, and the value can be a complex formula.
So, my code get s the last used DataGraphic and gets the Data Bars values
for all shapes that use it.

The code requires a reference to Microsoft Scripting Runtime (because I use
Dictionary class)...

Public Sub SetDataBarMinMaxValues()
'Purpose: Set the Min and Max Values of all databars in the active Data
Graphic
'Author : David J Parker, bVisual, 2008, no rights reserved
'Event : Visio Conference 2008

'Get the active Data Graphic
Dim mstDG As Master
Set mstDG = GetActiveDataGraphic
If mstDG Is Nothing Then
Exit Sub
End If

Dim shp As Visio.shape
Dim colDataBarShapes As New Collection

For Each shp In mstDG.Shapes(1).Shapes
If shp.IsDataGraphicCallout = True Then
If shp.Cells("User.msvCalloutType").ResultStr("") = "Data Bar"
Then
colDataBarShapes.Add shp.NameU
End If
End If
Next shp

If colDataBarShapes.Count = 0 Then
Exit Sub
End If

Dim iDataBar As Integer
Dim itmGraphic As shape
Dim pag As Visio.Page
Dim dicMinVal As New Dictionary
Dim dicMaxVal As New Dictionary
Dim sel As Visio.Selection

Const PropField As String = "Prop.msvCalloutField"
Const PropMax As String = "Prop.msvCalloutPropMax"
Const PropMin As String = "Prop.msvCalloutPropMin"
'From 2 to 5
Const PropFieldn As String = "Prop.msvCalloutPropField"
Dim iPropField As Integer
Dim propFieldName As String

'Iterate thru each page
For Each pag In Visio.ActiveDocument.Pages
'Get all shapes that use this data graphic master
Set sel = pag.CreateSelection(visSelTypeByDataGraphic, 0, mstDG)
'Iterate thru each shape in the selection
For Each shp In sel
For iDataBar = 1 To colDataBarShapes.Count
Set itmGraphic = shp.Shapes(colDataBarShapes(iDataBar))
'Update the maximum value
If dicMaxVal.Count = 0 Then
dicMaxVal.Add itmGraphic.NameU,
itmGraphic.Cells(PropField).ResultIU
ElseIf itmGraphic.Cells(PropField).ResultIU >
dicMaxVal.Item(itmGraphic.NameU) Then
dicMaxVal.Item(itmGraphic.NameU) =
itmGraphic.Cells(PropField).ResultIU
End If
'Update the minimum value
If dicMinVal.Count = 0 Then
dicMinVal.Add itmGraphic.NameU,
itmGraphic.Cells(PropField).ResultIU
ElseIf itmGraphic.Cells(PropField).ResultIU <
dicMinVal.Item(itmGraphic.NameU) Then
dicMinVal.Item(itmGraphic.NameU) =
itmGraphic.Cells(PropField).ResultIU
End If
'Multi-stack bars can have multiple fields with values to
check
For iPropField = 2 To 5
propFieldName = PropFieldn & CStr(iPropField)
If itmGraphic.CellExistsU(propFieldName,
Visio.visExistsAnywhere) Then
'Unused fields have formula =NA()
If Not itmGraphic.Cells(propFieldName).FormulaU =
"NA()" Then
'Update the maximum value
If dicMaxVal.Count = 0 Then
dicMaxVal.Add itmGraphic.NameU,
itmGraphic.Cells(propFieldName).ResultIU
ElseIf itmGraphic.Cells(propFieldName).ResultIU

dicMaxVal.Item(itmGraphic.NameU) Then

dicMaxVal.Item(itmGraphic.NameU) =
itmGraphic.Cells(propFieldName).ResultIU
End If
'Update the minimum value
If dicMinVal.Count = 0 Then
dicMinVal.Add itmGraphic.NameU,
itmGraphic.Cells(propFieldName).ResultIU
ElseIf itmGraphic.Cells(propFieldName).ResultIU
< dicMinVal.Item(itmGraphic.NameU) Then
dicMinVal.Item(itmGraphic.NameU) =
itmGraphic.Cells(propFieldName).ResultIU
End If
End If
Else
Exit For
End If
Next iPropField
Next iDataBar
Next shp
Next pag

'Finally - update the ItemGraphic in the DataGraphic Master
Dim mstCopy As Visio.Master
Set mstCopy = mstDG.Open
For iDataBar = 1 To colDataBarShapes.Count
Set itmGraphic =
mstCopy.Shapes(1).Shapes(colDataBarShapes.Item(iDataBar))
itmGraphic.Cells(PropMax).FormulaU = "=" &
dicMaxVal.Item(colDataBarShapes.Item(iDataBar))
itmGraphic.Cells(PropMin).FormulaU = "=" &
dicMinVal.Item(colDataBarShapes.Item(iDataBar))
Debug.Print colDataBarShapes.Item(iDataBar),
dicMinVal.Item(colDataBarShapes.Item(iDataBar)),
dicMaxVal.Item(colDataBarShapes.Item(iDataBar))
Next iDataBar
'Close the copy to update all instances
mstCopy.Close
End Sub

 

[David Parker]

Oops ... I found an error that occurs when you use the same data bar in the
same data graphic, so I have had to revise my code:

Public Sub SetDataBarMinMaxValues()
'Purpose: Set the Min and Max Values of all databars in the active Data
Graphic
'Author : David J Parker, bVisual, 2008, no rights reserved
'Event : Visio Conference 2008

'Get the active Data Graphic
Dim mstDG As Master
Set mstDG = GetActiveDataGraphic
If mstDG Is Nothing Then
Exit Sub
End If

Dim shp As Visio.shape
Dim dicDataBarShapes As New Dictionary
Dim gi As Visio.GraphicItem
'Create a dictionary of data bars
For Each gi In mstDG.GraphicItems
If gi.Type = visTypeDataBar Then
dicDataBarShapes.Add CStr(gi.ID), 0
End If
Next gi

Dim colDataBarShapes As New Collection
Dim itmGraphic As Visio.shape
Dim gID As String
Dim idx As Integer
idx = 0
'Update the data bars dictionary with shape pseudo-index
For Each itmGraphic In mstDG.Shapes(1).Shapes
If itmGraphic.IsDataGraphicCallout = True Then
If itmGraphic.Cells("User.msvCalloutType").ResultStr("") = "Data
Bar" Then
idx = idx + 1
gID =
CStr(itmGraphic.Cells("User.visDGItemID").ResultInt("", 0))
dicDataBarShapes.Item(gID) = itmGraphic.NameU
colDataBarShapes.Add gID
End If
End If
Next itmGraphic

If dicDataBarShapes.Count = 0 Then
Exit Sub
End If

Dim pag As Visio.Page
Dim dicMinVal As New Dictionary
Dim dicMaxVal As New Dictionary
Dim sel As Visio.Selection

Const PropField As String = "Prop.msvCalloutField"
Const PropMax As String = "Prop.msvCalloutPropMax"
Const PropMin As String = "Prop.msvCalloutPropMin"
'From 2 to 5
Const PropFieldn As String = "Prop.msvCalloutPropField"
Dim iPropField As Integer
Dim propFieldName As String
Dim itemFormula As String

'Iterate thru each page
For Each pag In Visio.ActiveDocument.Pages
'Get all shapes that use this data graphic master
Set sel = pag.CreateSelection(visSelTypeByDataGraphic, 0, mstDG)
'Iterate thru each shape in the selection
For Each shp In sel
idx = 0
For Each itmGraphic In shp.Shapes
If itmGraphic.IsDataGraphicCallout = True Then
If itmGraphic.Cells("User.msvCalloutType").ResultStr("")
= "Data Bar" Then
idx = idx + 1
gID = colDataBarShapes.Item(idx)

'Set itmGraphic =
shp.Shapes(colDataBarShapes(iDataBar))
'Update the maximum value
If dicMaxVal.Count = 0 Then
dicMaxVal.Add gID,
itmGraphic.Cells(PropField).ResultIU
ElseIf itmGraphic.Cells(PropField).ResultIU >
dicMaxVal.Item(gID) Then
dicMaxVal.Item(gID) =
itmGraphic.Cells(PropField).ResultIU
End If
'Update the minimum value
If dicMinVal.Count = 0 Then
dicMinVal.Add gID,
itmGraphic.Cells(PropField).ResultIU
ElseIf itmGraphic.Cells(PropField).ResultIU <
dicMinVal.Item(gID) Then
dicMinVal.Item(gID) =
itmGraphic.Cells(PropField).ResultIU
End If
'Multi-stack bars can have multiple fields with
values to check
For iPropField = 2 To 5
propFieldName = PropFieldn & CStr(iPropField)
If itmGraphic.CellExistsU(propFieldName,
Visio.visExistsAnywhere) Then
'Unused fields have formula =NA()
If Not
itmGraphic.Cells(propFieldName).FormulaU = "NA()" Then
'Update the maximum value
If dicMaxVal.Count = 0 Then
dicMaxVal.Add gID,
itmGraphic.Cells(propFieldName).ResultIU
ElseIf
itmGraphic.Cells(propFieldName).ResultIU > dicMaxVal.Item(gID) Then
dicMaxVal.Item(gID) =
itmGraphic.Cells(propFieldName).ResultIU
End If
'Update the minimum value
If dicMinVal.Count = 0 Then
dicMinVal.Add gID,
itmGraphic.Cells(propFieldName).ResultIU
ElseIf
itmGraphic.Cells(propFieldName).ResultIU < dicMinVal.Item(gID) Then
dicMinVal.Item(gID) =
itmGraphic.Cells(propFieldName).ResultIU
End If
End If
Else
Exit For
End If
Next iPropField
End If
End If
Next itmGraphic
Next shp
Next pag

'Finally - update the ItemGraphic in the DataGraphic Master
Dim mstCopy As Visio.Master
Set mstCopy = mstDG.Open
idx = 0
For Each itmGraphic In mstCopy.Shapes(1).Shapes
If itmGraphic.IsDataGraphicCallout = True Then
If itmGraphic.Cells("User.msvCalloutType").ResultStr("") = "Data
Bar" Then
idx = idx + 1
gID =
CStr(itmGraphic.Cells("User.visDGItemID").ResultInt("", 0))
itmGraphic.Cells(PropMax).FormulaU = "=" &
dicMaxVal.Item(gID)
itmGraphic.Cells(PropMin).FormulaU = "=" &
dicMinVal.Item(gID)
End If
End If
Next itmGraphic
'Close the copy to update all instances
mstCopy.Close
End Sub