Has any one had experience creating bullet graphs in Access. I can
successfully do a bullet style graph vertically (columns) but am
having trouble doing horizontal (bars). The problem is this, to create
the Target indicator you need to use the marker from a line series.
Access will not (as best I can tell) plot a line series vertically (as
opposed to left to right).

Thanks in advance for your help.

On Dec 29 2009, 3:37 pm, bigmike2001 <bigmike2...@gmail.com> wrote:
> Has any one had experience creating bullet graphs in Access. I can
> successfully do a bullet style graph vertically (columns) but am
> having trouble doing horizontal (bars). The problem is this, to create
> the Target indicator you need to use the marker from a line series.
> Access will not (as best I can tell) plot a line series vertically (as
> opposed to left to right).
>
> Thanks in advance for your help.

I created a Bullet Graph as a PDF file from A97 to mimic the example
shown on the last page of the Bullet Graph Design Specification by
Stephen Few, the creator of the Bullet Graph:

https://files.oakland.edu/users/fort...ulletGraph.pdf

It looks as though Bullet Graphs will be pretty handy for some of the
reports I generate. Each graph added should add about 5 Kb to the
size of the report. I used a variant array with 43 values as input to
specify all the colors (three values for each color), the page
location, label content, bar widths, font sizes, etc. Post back if
you want details about the function I used to create the sample Bullet
Graph.

James A. Fortune
(E-Mail Removed)

By coincidence I am working on a pro bono project for a church where I can
use a bullet graph. I would appreciate it if you could send me the details
on how you created the sample Bullet Graph.

Thank you!

Steve
(E-Mail Removed)



"James A. Fortune" <(E-Mail Removed)> wrote in message
news:51f83a9a-47e8-47cc-9cbe-(E-Mail Removed)...
> On Dec 29 2009, 3:37 pm, bigmike2001 <bigmike2...@gmail.com> wrote:
>> Has any one had experience creating bullet graphs in Access. I can
>> successfully do a bullet style graph vertically (columns) but am
>> having trouble doing horizontal (bars). The problem is this, to create
>> the Target indicator you need to use the marker from a line series.
>> Access will not (as best I can tell) plot a line series vertically (as
>> opposed to left to right).
>>
>> Thanks in advance for your help.
>
> I created a Bullet Graph as a PDF file from A97 to mimic the example
> shown on the last page of the Bullet Graph Design Specification by
> Stephen Few, the creator of the Bullet Graph:
>
> https://files.oakland.edu/users/fort...ulletGraph.pdf
>
> It looks as though Bullet Graphs will be pretty handy for some of the
> reports I generate. Each graph added should add about 5 Kb to the
> size of the report. I used a variant array with 43 values as input to
> specify all the colors (three values for each color), the page
> location, label content, bar widths, font sizes, etc. Post back if
> you want details about the function I used to create the sample Bullet
> Graph.
>
> James A. Fortune
> (E-Mail Removed)

On Jan 5, 4:44 pm, "Steve" <notmyem...@address.com> wrote:
> By coincidence I am working on a pro bono project for a church where I can
> use a bullet graph. I would appreciate it if you could send me the details
> on how you created the sample Bullet Graph.
>
> Thank you!
>
> Steve
> san...@penn.com

Send, and hear about the great bullet graph program you've written? I
don't think that would be a good idea :-). Here ya go:

'Code behind form
Private Sub cmdMakeBulletGraph_Click()
Dim strOut As String
Dim strFileOut As String
Dim strCR As String
Dim dblFontBBFactor As Double
Dim dblTextToGraphGap As Double
Dim dblSubCaptionSink As Double
Dim varArguments(42) As Variant
Dim iMainCaption As Integer 'Str
Dim iSubCaption As Integer 'Str
Dim iFinishedValue As Integer 'Dbl
Dim iProjectedValue As Integer 'Dbl
Dim iBudgetedValue As Integer 'Dbl
Dim iBudgetedBarHeight As Integer 'Dbl
Dim iBudgetedBarWidth As Integer 'Dbl
Dim iThermometerHeight As Integer 'Dbl
Dim iBarAreaHeight As Integer 'Dbl
Dim iBarAreaWidth As Integer 'Dbl
Dim iTickHeight As Integer 'Dbl
Dim iTickWidth As Integer 'Dbl
Dim iNumberOfAxisTicks As Integer 'Int
Dim iXValueMin As Integer 'Dbl
Dim iXValueMax As Integer 'Dbl
Dim iMainCaptionOriginX As Integer 'Dbl
Dim iMainCaptionOriginY As Integer 'Dbl
Dim iSubCaptionOriginX As Integer 'Dbl
Dim iSubCaptionOriginY As Integer 'Dbl
Dim iBarAreaOriginX As Integer 'Dbl
Dim iBarAreaOriginY As Integer 'Dbl
Dim iMainCaptionFont As Integer 'Str
Dim iMainCaptionFontSize As Integer 'Dbl
Dim iSubCaptionFont As Integer 'Str
Dim iSubCaptionFontSize As Integer 'Dbl
Dim iXAxisFont As Integer 'Str
Dim iXAxisFontSize As Integer 'Dbl
Dim iProjectedR As Integer 'Dbl
Dim iProjectedG As Integer 'Dbl
Dim iProjectedB As Integer 'Dbl
Dim iGray1Color As Integer 'Dbl
Dim iGray2Color As Integer 'Dbl
Dim iGray3Color As Integer 'Dbl
Dim iGray1Value As Integer 'Dbl
Dim iGray2Value As Integer 'Dbl
Dim iGray3Value As Integer 'Dbl
Dim iFinishedR As Integer 'Dbl
Dim iFinishedG As Integer 'Dbl
Dim iFinishedB As Integer 'Dbl
Dim iBudgetedR As Integer 'Dbl
Dim iBudgetedG As Integer 'Dbl
Dim iBudgetedB As Integer 'Dbl
Dim iTickGray As Integer 'Dbl

dblFontBBFactor = 0.9
dblTextToGraphGap = 9
dblSubCaptionSink = 2
iMainCaption = 0
iSubCaption = 1
iFinishedValue = 2
iProjectedValue = 3
iBudgetedValue = 4
iBudgetedBarHeight = 5
iBudgetedBarWidth = 6
iThermometerHeight = 7
iBarAreaHeight = 8
iBarAreaWidth = 9
iTickHeight = 10
iTickWidth = 11
iNumberOfAxisTicks = 12
iXValueMin = 13
iXValueMax = 14
iMainCaptionFont = 15
iMainCaptionFontSize = 16
iSubCaptionFont = 17
iSubCaptionFontSize = 18
iXAxisFont = 19
iXAxisFontSize = 20
iBarAreaOriginX = 21
iBarAreaOriginY = 22
iMainCaptionOriginX = 23
iMainCaptionOriginY = 24
iSubCaptionOriginX = 25
iSubCaptionOriginY = 26
iProjectedR = 27
iProjectedG = 28
iProjectedB = 29
iGray1Color = 30
iGray2Color = 31
iGray3Color = 32
iGray1Value = 33
iGray2Value = 34
iGray3Value = 35
iFinishedR = 36
iFinishedG = 37
iFinishedB = 38
iBudgetedR = 39
iBudgetedG = 40
iBudgetedB = 41
iTickGray = 42

varArguments(iMainCaption) = "Revenue Q1 2005"
varArguments(iSubCaption) = "(U.S. $ in thousands)"
varArguments(iFinishedValue) = 60.71
varArguments(iProjectedValue) = 259.3
varArguments(iBudgetedValue) = 250
varArguments(iBudgetedBarHeight) = 14
varArguments(iBudgetedBarWidth) = 1.4
varArguments(iThermometerHeight) = 6.5
varArguments(iBarAreaHeight) = 20
varArguments(iBarAreaWidth) = 253
varArguments(iTickHeight) = 5.5
varArguments(iTickWidth) = 0.2
varArguments(iNumberOfAxisTicks) = 7
varArguments(iXValueMin) = 0
varArguments(iXValueMax) = 300
varArguments(iMainCaptionFont) = "Helvetica"
varArguments(iMainCaptionFontSize) = 9
varArguments(iSubCaptionFont) = "Helvetica"
varArguments(iSubCaptionFontSize) = 7
varArguments(iXAxisFont) = "Helvetica"
varArguments(iXAxisFontSize) = 7
varArguments(iBarAreaOriginX) = 227
varArguments(iBarAreaOriginY) = 576
'Right align the captions dblTextToGraphGap (9) pts to the left of the
bars
'The origins should probably be done in the function instead
varArguments(iMainCaptionOriginX) = varArguments(iBarAreaOriginX) -
dblTextToGraphGap - GetFontWidth(CStr(varArguments(iMainCaption)), CStr
(varArguments(iMainCaptionFont)), CDbl(varArguments
(iMainCaptionFontSize)))
'Line the Caption up with the center bar
varArguments(iMainCaptionOriginY) = varArguments(iBarAreaOriginY) +
varArguments(iBarAreaHeight) / 2 - varArguments(iMainCaptionFontSize)
* dblFontBBFactor / 2
'Right align the captions dblTextToGraphGap (9) pts to the left of the
bars
varArguments(iSubCaptionOriginX) = varArguments(iBarAreaOriginX) -
dblTextToGraphGap - GetFontWidth(CStr(varArguments(iSubCaption)), CStr
(varArguments(iSubCaptionFont)), CDbl(varArguments
(iSubCaptionFontSize)))
'Line the SubCaption so that the top is about 2 pts below the bar
varArguments(iSubCaptionOriginY) = varArguments(iBarAreaOriginY) -
varArguments(iSubCaptionFontSize) * dblFontBBFactor -
dblSubCaptionSink
varArguments(iProjectedR) = 0.38
varArguments(iProjectedG) = 0.565
varArguments(iProjectedB) = 0.784
varArguments(iGray1Color) = 0.659
varArguments(iGray2Color) = 0.781
varArguments(iGray3Color) = 0.907
varArguments(iGray1Value) = 200
varArguments(iGray2Value) = 250
varArguments(iGray3Value) = 300
varArguments(iFinishedR) = 0.118
varArguments(iFinishedG) = 0.443
varArguments(iFinishedB) = 0.722
varArguments(iBudgetedR) = 0.165
varArguments(iBudgetedG) = 0.467
varArguments(iBudgetedB) = 0.725
varArguments(iTickGray) = 0.659

strCR = Chr(13)
strFileOut = "C:\TestBulletGraph.txt"
strOut = DrawHorizontalBulletGraph(varArguments())

Open strFileOut For Output As #1
Print #1, strOut
Close
MsgBox ("Done.")
End Sub
'End Code behind form

'Module Code
Public Function DrawHorizontalBulletGraph(varInput() As Variant) As
String
Dim strTemp As String
Dim strCR As String
Dim I As Integer
Dim dblCurXLabelX As Double
Dim dblCurXLabelY As Double
Dim iMainCaption As Integer 'Str
Dim iSubCaption As Integer 'Str
Dim iFinishedValue As Integer 'Dbl
Dim iProjectedValue As Integer 'Dbl
Dim iBudgetedValue As Integer 'Dbl
Dim iBudgetedBarHeight As Integer 'Dbl
Dim iBudgetedBarWidth As Integer 'Dbl
Dim iThermometerHeight As Integer 'Dbl
Dim iBarAreaHeight As Integer 'Dbl
Dim iBarAreaWidth As Integer 'Dbl
Dim iTickHeight As Integer 'Dbl
Dim iTickWidth As Integer 'Dbl
Dim iNumberOfAxisTicks As Integer 'Int
Dim iXValueMin As Integer 'Dbl
Dim iXValueMax As Integer 'Dbl
Dim iMainCaptionOriginX As Integer 'Dbl
Dim iMainCaptionOriginY As Integer 'Dbl
Dim iSubCaptionOriginX As Integer 'Dbl
Dim iSubCaptionOriginY As Integer 'Dbl
Dim iBarAreaOriginX As Integer 'Dbl
Dim iBarAreaOriginY As Integer 'Dbl
Dim iMainCaptionFont As Integer 'Str
Dim iMainCaptionFontSize As Integer 'Dbl
Dim iSubCaptionFont As Integer 'Str
Dim iSubCaptionFontSize As Integer 'Dbl
Dim iXAxisFont As Integer 'Str
Dim iXAxisFontSize As Integer 'Dbl
Dim iProjectedR As Integer 'Dbl
Dim iProjectedG As Integer 'Dbl
Dim iProjectedB As Integer 'Dbl
Dim iGray1Color As Integer 'Dbl
Dim iGray2Color As Integer 'Dbl
Dim iGray3Color As Integer 'Dbl
Dim iGray1Value As Integer 'Dbl
Dim iGray2Value As Integer 'Dbl
Dim iGray3Value As Integer 'Dbl
Dim iFinishedR As Integer 'Dbl
Dim iFinishedG As Integer 'Dbl
Dim iFinishedB As Integer 'Dbl
Dim iBudgetedR As Integer 'Dbl
Dim iBudgetedG As Integer 'Dbl
Dim iBudgetedB As Integer 'Dbl
Dim iTickGray As Integer 'Dbl
Dim dblXAxisValues() As Double
Dim dblTickX() As Double
Dim intFontNumber As Integer

iMainCaption = 0
iSubCaption = 1
iFinishedValue = 2
iProjectedValue = 3
iBudgetedValue = 4
iBudgetedBarHeight = 5
iBudgetedBarWidth = 6
iThermometerHeight = 7
iBarAreaHeight = 8
iBarAreaWidth = 9
iTickHeight = 10
iTickWidth = 11
iNumberOfAxisTicks = 12
iXValueMin = 13
iXValueMax = 14
iMainCaptionFont = 15
iMainCaptionFontSize = 16
iSubCaptionFont = 17
iSubCaptionFontSize = 18
iXAxisFont = 19
iXAxisFontSize = 20
iBarAreaOriginX = 21
iBarAreaOriginY = 22
iMainCaptionOriginX = 23
iMainCaptionOriginY = 24
iSubCaptionOriginX = 25
iSubCaptionOriginY = 26
iProjectedR = 27
iProjectedG = 28
iProjectedB = 29
iGray1Color = 30
iGray2Color = 31
iGray3Color = 32
iGray1Value = 33
iGray2Value = 34
iGray3Value = 35
iFinishedR = 36
iFinishedG = 37
iFinishedB = 38
iBudgetedR = 39
iBudgetedG = 40
iBudgetedB = 41
iTickGray = 42
ReDim dblXAxisValues(varInput(iNumberOfAxisTicks)) As Double
ReDim dblTickX(varInput(iNumberOfAxisTicks)) As Double
For I = 1 To varInput(iNumberOfAxisTicks)
dblXAxisValues(I) = varInput(iXValueMin) + (I - 1) * (varInput
(iXValueMax) - varInput(iXValueMin)) / (varInput(iNumberOfAxisTicks) -
1)
dblTickX(I) = varInput(iBarAreaOriginX) + varInput(iBarAreaWidth) *
(I - 1) / (varInput(iNumberOfAxisTicks) - 1)
Next I
strCR = Chr(13)
strTemp = "%Bullet Graph" & strCR
strTemp = strTemp & "q" & strCR
'Draw the gray rectangles
'strTemp = strTemp & "" & strCR
strTemp = strTemp & "q" & strCR
strTemp = strTemp & "0.01 w" & strCR
strTemp = strTemp & varInput(iGray3Color) & " g" & strCR 'fill color
strTemp = strTemp & varInput(iGray3Color) & " G" & strCR 'border color
'strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
(iBarAreaOriginY) & " " & varInput(iBarAreaWidth) & " " & varInput
(iBarAreaHeight) & " re" & strCR
'Allow the lightest gray background to go beyond the last tick mark
strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
(iBarAreaOriginY) & " " & ValToPts(CDbl(varInput(iGray3Value)), CDbl
(varInput(iXValueMin)), CDbl(varInput(iXValueMax)), CDbl(varInput
(iBarAreaWidth))) & " " & varInput(iBarAreaHeight) & " re" & strCR
strTemp = strTemp & "b S" & strCR
strTemp = strTemp & "Q" & strCR
strTemp = strTemp & "q" & strCR
strTemp = strTemp & "0.01 w" & strCR
strTemp = strTemp & varInput(iGray2Color) & " g" & strCR
strTemp = strTemp & varInput(iGray2Color) & " G" & strCR
strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
(iBarAreaOriginY) & " " & ValToPts(CDbl(varInput(iGray2Value)), CDbl
(varInput(iXValueMin)), CDbl(varInput(iXValueMax)), CDbl(varInput
(iBarAreaWidth))) & " " & varInput(iBarAreaHeight) & " re" & strCR
strTemp = strTemp & "b S" & strCR
strTemp = strTemp & "Q" & strCR
strTemp = strTemp & "q" & strCR
strTemp = strTemp & "0.01 w" & strCR
strTemp = strTemp & varInput(iGray1Color) & " g" & strCR
strTemp = strTemp & varInput(iGray1Color) & " G" & strCR
strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
(iBarAreaOriginY) & " " & ValToPts(CDbl(varInput(iGray1Value)), CDbl
(varInput(iXValueMin)), CDbl(varInput(iXValueMax)), CDbl(varInput
(iBarAreaWidth))) & " " & varInput(iBarAreaHeight) & " re" & strCR
strTemp = strTemp & "b S" & strCR
strTemp = strTemp & "Q" & strCR
'Draw the ticks and X-Axis numbers
For I = 1 To varInput(iNumberOfAxisTicks)
strTemp = strTemp & "q" & strCR
strTemp = strTemp & "0.01 w" & strCR
strTemp = strTemp & varInput(iTickGray) & " g" & strCR 'fill color
strTemp = strTemp & varInput(iTickGray) & " G" & strCR 'border color
strTemp = strTemp & CStr(dblTickX(I) - varInput(iTickWidth) / 2) & "
" & varInput(iBarAreaOriginY) - varInput(iTickHeight) & " " & varInput
(iTickWidth) & " " & varInput(iTickHeight) & " re" & strCR
strTemp = strTemp & "b S" & strCR
strTemp = strTemp & "Q" & strCR
strTemp = strTemp & "BT" & strCR
intFontNumber = GetFontNumber(CStr(varInput(iXAxisFont)))
strTemp = strTemp & "/F" & CStr(intFontNumber) & " " & CStr(varInput
(iXAxisFontSize)) & " Tf" & strCR
strTemp = strTemp & dblTickX(I) - GetFontWidth(Format(dblXAxisValues
(I), "0"), CStr(varInput(iXAxisFont)), CDbl(varInput
(iXAxisFontSize))) / 2 & " " & varInput(iBarAreaOriginY) - varInput
(iTickHeight) - 4 - varInput(iXAxisFontSize) * 0.85 & "1 Td" & strCR
strTemp = strTemp & "(" & Format(dblXAxisValues(I), "0") & ") Tj" &
strCR
strTemp = strTemp & "ET" & strCR
Next I
'Draw the captions
strTemp = strTemp & "BT" & strCR
intFontNumber = GetFontNumber(CStr(varInput(iMainCaptionFont)))
strTemp = strTemp & "/F" & CStr(intFontNumber) & " " & CStr(varInput
(iMainCaptionFontSize)) & " Tf" & strCR
strTemp = strTemp & CStr(varInput(iMainCaptionOriginX)) & " " & CStr
(varInput(iMainCaptionOriginY)) & "1 Td" & strCR
strTemp = strTemp & "(" & TLit(CStr(varInput(iMainCaption))) & ") Tj"
& strCR
strTemp = strTemp & "ET" & strCR
strTemp = strTemp & "BT" & strCR
intFontNumber = GetFontNumber(CStr(varInput(iSubCaptionFont)))
strTemp = strTemp & "/F" & CStr(intFontNumber) & " " & CStr(varInput
(iSubCaptionFontSize)) & " Tf" & strCR
strTemp = strTemp & CStr(varInput(iSubCaptionOriginX)) & " " & CStr
(varInput(iSubCaptionOriginY)) & "1 Td" & strCR
strTemp = strTemp & "(" & TLit(CStr(varInput(iSubCaption))) & ") Tj" &
strCR
strTemp = strTemp & "ET" & strCR
'Draw the projected bar
strTemp = strTemp & "q" & strCR
strTemp = strTemp & "0.01 w" & strCR
strTemp = strTemp & varInput(iProjectedR) & " " & varInput
(iProjectedG) & " " & varInput(iProjectedB) & " rg" & strCR
strTemp = strTemp & varInput(iProjectedR) & " " & varInput
(iProjectedG) & " " & varInput(iProjectedB) & " RG" & strCR
strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
(iBarAreaOriginY) + varInput(iBarAreaHeight) / 2 - varInput
(iThermometerHeight) / 2 & " " & ValToPts(CDbl(varInput
(iProjectedValue)), CDbl(varInput(iXValueMin)), CDbl(varInput
(iXValueMax)), CDbl(varInput(iBarAreaWidth))) & " " & varInput
(iThermometerHeight) & " re" & strCR
strTemp = strTemp & "b S" & strCR
strTemp = strTemp & "Q" & strCR
'Draw the finished bar
strTemp = strTemp & "q" & strCR
strTemp = strTemp & "0.01 w" & strCR
strTemp = strTemp & varInput(iFinishedR) & " " & varInput(iFinishedG)
& " " & varInput(iFinishedB) & " rg" & strCR
strTemp = strTemp & varInput(iFinishedR) & " " & varInput(iFinishedG)
& " " & varInput(iFinishedB) & " RG" & strCR
strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
(iBarAreaOriginY) + varInput(iBarAreaHeight) / 2 - varInput
(iThermometerHeight) / 2 & " " & ValToPts(CDbl(varInput
(iFinishedValue)), CDbl(varInput(iXValueMin)), CDbl(varInput
(iXValueMax)), CDbl(varInput(iBarAreaWidth))) & " " & varInput
(iThermometerHeight) & " re" & strCR
strTemp = strTemp & "b S" & strCR
strTemp = strTemp & "Q" & strCR
'Draw the budgeted mark
strTemp = strTemp & "q" & strCR
strTemp = strTemp & "0.01 w" & strCR
strTemp = strTemp & varInput(iBudgetedR) & " " & varInput(iBudgetedG)
& " " & varInput(iBudgetedB) & " rg" & strCR
strTemp = strTemp & varInput(iBudgetedR) & " " & varInput(iBudgetedG)
& " " & varInput(iBudgetedB) & " RG" & strCR
strTemp = strTemp & varInput(iBarAreaOriginX) + ValToPts(CDbl(varInput
(iBudgetedValue)), CDbl(varInput(iXValueMin)), CDbl(varInput
(iXValueMax)), CDbl(varInput(iBarAreaWidth))) - CDbl(varInput
(iBudgetedBarWidth)) / 2 & " " & varInput(iBarAreaOriginY) + varInput
(iBarAreaHeight) / 2 - varInput(iBudgetedBarHeight) / 2 & " " &
varInput(iBudgetedBarWidth) & " " & varInput(iBudgetedBarHeight) & "
re" & strCR
strTemp = strTemp & "b S" & strCR
strTemp = strTemp & "Q" & strCR
DrawHorizontalBulletGraph = strTemp
End Function

Private Function ValToPts(dblV As Double, dblMinValue As Double,
dblMaxValue As Double, dblRangePts As Double) As Double
ValToPts = dblV * dblRangePts / (dblMaxValue - dblMinValue)
End Function

Function TLit(strIn As String) As String
Dim strTemp As String
Dim intI As Integer
Dim strChar As String

'Transform Literals
TLit = ""
If Len(strIn) = 0 Then Exit Function
For intI = 1 To Len(strIn)
strChar = Mid(strIn, intI, 1)
Select Case strChar
Case "\":
strTemp = strTemp & "\\"
Case "(":
strTemp = strTemp & "\("
Case ")":
strTemp = strTemp & "\)"
Case Else
strTemp = strTemp & strChar
End Select
Next intI
TLit = strTemp
End Function

Public Function GetFontNumber(strFontName) As Integer
Select Case strFontName
Case "Courier":
GetFontNumber = 1
Case "CourierBold":
GetFontNumber = 2
Case "Helvetica":
GetFontNumber = 3
Case "HelveticaBold":
GetFontNumber = 4
Case Else
GetFontNumber = 0
End Select
End Function
'End Module Code

That should produce a layout text file that can be imported into the
PDFLayoutViewer I posted and used to create a PDF (The existing
Portrait mode is adequate). I put a bunch of controls on the form so
that I can test the function further, but haven't gotten around to
hooking the array values up to the form controls yet. The PDF ellipse
code I posted not long ago can be incorporated to make an elliptical
marker if you really want to make an impression. Inside a report loop
it is only necessary to change a few array elements once the array
defaults are set up. I have created some functions that center or
justify text and automatically scale the text to fit, but those
haven't been added yet either. Those functions allow me to replace
the five or six lines of text creation code with a single function
call. My idea for a job report is to use different colors for the
thermometer part depending on whether the job is on budget, leaning
toward being over budget (projected goes past the marker) or actually
over budget (actual goes past the marker - guess what color I'll use
for that). That should at least get you going on your worthy
endeavor.

James A. Fortune
(E-Mail Removed)

Thank you!!!


"James A. Fortune" <(E-Mail Removed)> wrote in message
news:225c8940-7a7a-40af-87cf-(E-Mail Removed)...
> On Jan 5, 4:44 pm, "Steve" <notmyem...@address.com> wrote:
>> By coincidence I am working on a pro bono project for a church where I
>> can
>> use a bullet graph. I would appreciate it if you could send me the
>> details
>> on how you created the sample Bullet Graph.
>>
>> Thank you!
>>
>> Steve
>> san...@penn.com
>
> Send, and hear about the great bullet graph program you've written? I
> don't think that would be a good idea :-). Here ya go:
>
> 'Code behind form
> Private Sub cmdMakeBulletGraph_Click()
> Dim strOut As String
> Dim strFileOut As String
> Dim strCR As String
> Dim dblFontBBFactor As Double
> Dim dblTextToGraphGap As Double
> Dim dblSubCaptionSink As Double
> Dim varArguments(42) As Variant
> Dim iMainCaption As Integer 'Str
> Dim iSubCaption As Integer 'Str
> Dim iFinishedValue As Integer 'Dbl
> Dim iProjectedValue As Integer 'Dbl
> Dim iBudgetedValue As Integer 'Dbl
> Dim iBudgetedBarHeight As Integer 'Dbl
> Dim iBudgetedBarWidth As Integer 'Dbl
> Dim iThermometerHeight As Integer 'Dbl
> Dim iBarAreaHeight As Integer 'Dbl
> Dim iBarAreaWidth As Integer 'Dbl
> Dim iTickHeight As Integer 'Dbl
> Dim iTickWidth As Integer 'Dbl
> Dim iNumberOfAxisTicks As Integer 'Int
> Dim iXValueMin As Integer 'Dbl
> Dim iXValueMax As Integer 'Dbl
> Dim iMainCaptionOriginX As Integer 'Dbl
> Dim iMainCaptionOriginY As Integer 'Dbl
> Dim iSubCaptionOriginX As Integer 'Dbl
> Dim iSubCaptionOriginY As Integer 'Dbl
> Dim iBarAreaOriginX As Integer 'Dbl
> Dim iBarAreaOriginY As Integer 'Dbl
> Dim iMainCaptionFont As Integer 'Str
> Dim iMainCaptionFontSize As Integer 'Dbl
> Dim iSubCaptionFont As Integer 'Str
> Dim iSubCaptionFontSize As Integer 'Dbl
> Dim iXAxisFont As Integer 'Str
> Dim iXAxisFontSize As Integer 'Dbl
> Dim iProjectedR As Integer 'Dbl
> Dim iProjectedG As Integer 'Dbl
> Dim iProjectedB As Integer 'Dbl
> Dim iGray1Color As Integer 'Dbl
> Dim iGray2Color As Integer 'Dbl
> Dim iGray3Color As Integer 'Dbl
> Dim iGray1Value As Integer 'Dbl
> Dim iGray2Value As Integer 'Dbl
> Dim iGray3Value As Integer 'Dbl
> Dim iFinishedR As Integer 'Dbl
> Dim iFinishedG As Integer 'Dbl
> Dim iFinishedB As Integer 'Dbl
> Dim iBudgetedR As Integer 'Dbl
> Dim iBudgetedG As Integer 'Dbl
> Dim iBudgetedB As Integer 'Dbl
> Dim iTickGray As Integer 'Dbl
>
> dblFontBBFactor = 0.9
> dblTextToGraphGap = 9
> dblSubCaptionSink = 2
> iMainCaption = 0
> iSubCaption = 1
> iFinishedValue = 2
> iProjectedValue = 3
> iBudgetedValue = 4
> iBudgetedBarHeight = 5
> iBudgetedBarWidth = 6
> iThermometerHeight = 7
> iBarAreaHeight = 8
> iBarAreaWidth = 9
> iTickHeight = 10
> iTickWidth = 11
> iNumberOfAxisTicks = 12
> iXValueMin = 13
> iXValueMax = 14
> iMainCaptionFont = 15
> iMainCaptionFontSize = 16
> iSubCaptionFont = 17
> iSubCaptionFontSize = 18
> iXAxisFont = 19
> iXAxisFontSize = 20
> iBarAreaOriginX = 21
> iBarAreaOriginY = 22
> iMainCaptionOriginX = 23
> iMainCaptionOriginY = 24
> iSubCaptionOriginX = 25
> iSubCaptionOriginY = 26
> iProjectedR = 27
> iProjectedG = 28
> iProjectedB = 29
> iGray1Color = 30
> iGray2Color = 31
> iGray3Color = 32
> iGray1Value = 33
> iGray2Value = 34
> iGray3Value = 35
> iFinishedR = 36
> iFinishedG = 37
> iFinishedB = 38
> iBudgetedR = 39
> iBudgetedG = 40
> iBudgetedB = 41
> iTickGray = 42
>
> varArguments(iMainCaption) = "Revenue Q1 2005"
> varArguments(iSubCaption) = "(U.S. $ in thousands)"
> varArguments(iFinishedValue) = 60.71
> varArguments(iProjectedValue) = 259.3
> varArguments(iBudgetedValue) = 250
> varArguments(iBudgetedBarHeight) = 14
> varArguments(iBudgetedBarWidth) = 1.4
> varArguments(iThermometerHeight) = 6.5
> varArguments(iBarAreaHeight) = 20
> varArguments(iBarAreaWidth) = 253
> varArguments(iTickHeight) = 5.5
> varArguments(iTickWidth) = 0.2
> varArguments(iNumberOfAxisTicks) = 7
> varArguments(iXValueMin) = 0
> varArguments(iXValueMax) = 300
> varArguments(iMainCaptionFont) = "Helvetica"
> varArguments(iMainCaptionFontSize) = 9
> varArguments(iSubCaptionFont) = "Helvetica"
> varArguments(iSubCaptionFontSize) = 7
> varArguments(iXAxisFont) = "Helvetica"
> varArguments(iXAxisFontSize) = 7
> varArguments(iBarAreaOriginX) = 227
> varArguments(iBarAreaOriginY) = 576
> 'Right align the captions dblTextToGraphGap (9) pts to the left of the
> bars
> 'The origins should probably be done in the function instead
> varArguments(iMainCaptionOriginX) = varArguments(iBarAreaOriginX) -
> dblTextToGraphGap - GetFontWidth(CStr(varArguments(iMainCaption)), CStr
> (varArguments(iMainCaptionFont)), CDbl(varArguments
> (iMainCaptionFontSize)))
> 'Line the Caption up with the center bar
> varArguments(iMainCaptionOriginY) = varArguments(iBarAreaOriginY) +
> varArguments(iBarAreaHeight) / 2 - varArguments(iMainCaptionFontSize)
> * dblFontBBFactor / 2
> 'Right align the captions dblTextToGraphGap (9) pts to the left of the
> bars
> varArguments(iSubCaptionOriginX) = varArguments(iBarAreaOriginX) -
> dblTextToGraphGap - GetFontWidth(CStr(varArguments(iSubCaption)), CStr
> (varArguments(iSubCaptionFont)), CDbl(varArguments
> (iSubCaptionFontSize)))
> 'Line the SubCaption so that the top is about 2 pts below the bar
> varArguments(iSubCaptionOriginY) = varArguments(iBarAreaOriginY) -
> varArguments(iSubCaptionFontSize) * dblFontBBFactor -
> dblSubCaptionSink
> varArguments(iProjectedR) = 0.38
> varArguments(iProjectedG) = 0.565
> varArguments(iProjectedB) = 0.784
> varArguments(iGray1Color) = 0.659
> varArguments(iGray2Color) = 0.781
> varArguments(iGray3Color) = 0.907
> varArguments(iGray1Value) = 200
> varArguments(iGray2Value) = 250
> varArguments(iGray3Value) = 300
> varArguments(iFinishedR) = 0.118
> varArguments(iFinishedG) = 0.443
> varArguments(iFinishedB) = 0.722
> varArguments(iBudgetedR) = 0.165
> varArguments(iBudgetedG) = 0.467
> varArguments(iBudgetedB) = 0.725
> varArguments(iTickGray) = 0.659
>
> strCR = Chr(13)
> strFileOut = "C:\TestBulletGraph.txt"
> strOut = DrawHorizontalBulletGraph(varArguments())
>
> Open strFileOut For Output As #1
> Print #1, strOut
> Close
> MsgBox ("Done.")
> End Sub
> 'End Code behind form
>
> 'Module Code
> Public Function DrawHorizontalBulletGraph(varInput() As Variant) As
> String
> Dim strTemp As String
> Dim strCR As String
> Dim I As Integer
> Dim dblCurXLabelX As Double
> Dim dblCurXLabelY As Double
> Dim iMainCaption As Integer 'Str
> Dim iSubCaption As Integer 'Str
> Dim iFinishedValue As Integer 'Dbl
> Dim iProjectedValue As Integer 'Dbl
> Dim iBudgetedValue As Integer 'Dbl
> Dim iBudgetedBarHeight As Integer 'Dbl
> Dim iBudgetedBarWidth As Integer 'Dbl
> Dim iThermometerHeight As Integer 'Dbl
> Dim iBarAreaHeight As Integer 'Dbl
> Dim iBarAreaWidth As Integer 'Dbl
> Dim iTickHeight As Integer 'Dbl
> Dim iTickWidth As Integer 'Dbl
> Dim iNumberOfAxisTicks As Integer 'Int
> Dim iXValueMin As Integer 'Dbl
> Dim iXValueMax As Integer 'Dbl
> Dim iMainCaptionOriginX As Integer 'Dbl
> Dim iMainCaptionOriginY As Integer 'Dbl
> Dim iSubCaptionOriginX As Integer 'Dbl
> Dim iSubCaptionOriginY As Integer 'Dbl
> Dim iBarAreaOriginX As Integer 'Dbl
> Dim iBarAreaOriginY As Integer 'Dbl
> Dim iMainCaptionFont As Integer 'Str
> Dim iMainCaptionFontSize As Integer 'Dbl
> Dim iSubCaptionFont As Integer 'Str
> Dim iSubCaptionFontSize As Integer 'Dbl
> Dim iXAxisFont As Integer 'Str
> Dim iXAxisFontSize As Integer 'Dbl
> Dim iProjectedR As Integer 'Dbl
> Dim iProjectedG As Integer 'Dbl
> Dim iProjectedB As Integer 'Dbl
> Dim iGray1Color As Integer 'Dbl
> Dim iGray2Color As Integer 'Dbl
> Dim iGray3Color As Integer 'Dbl
> Dim iGray1Value As Integer 'Dbl
> Dim iGray2Value As Integer 'Dbl
> Dim iGray3Value As Integer 'Dbl
> Dim iFinishedR As Integer 'Dbl
> Dim iFinishedG As Integer 'Dbl
> Dim iFinishedB As Integer 'Dbl
> Dim iBudgetedR As Integer 'Dbl
> Dim iBudgetedG As Integer 'Dbl
> Dim iBudgetedB As Integer 'Dbl
> Dim iTickGray As Integer 'Dbl
> Dim dblXAxisValues() As Double
> Dim dblTickX() As Double
> Dim intFontNumber As Integer
>
> iMainCaption = 0
> iSubCaption = 1
> iFinishedValue = 2
> iProjectedValue = 3
> iBudgetedValue = 4
> iBudgetedBarHeight = 5
> iBudgetedBarWidth = 6
> iThermometerHeight = 7
> iBarAreaHeight = 8
> iBarAreaWidth = 9
> iTickHeight = 10
> iTickWidth = 11
> iNumberOfAxisTicks = 12
> iXValueMin = 13
> iXValueMax = 14
> iMainCaptionFont = 15
> iMainCaptionFontSize = 16
> iSubCaptionFont = 17
> iSubCaptionFontSize = 18
> iXAxisFont = 19
> iXAxisFontSize = 20
> iBarAreaOriginX = 21
> iBarAreaOriginY = 22
> iMainCaptionOriginX = 23
> iMainCaptionOriginY = 24
> iSubCaptionOriginX = 25
> iSubCaptionOriginY = 26
> iProjectedR = 27
> iProjectedG = 28
> iProjectedB = 29
> iGray1Color = 30
> iGray2Color = 31
> iGray3Color = 32
> iGray1Value = 33
> iGray2Value = 34
> iGray3Value = 35
> iFinishedR = 36
> iFinishedG = 37
> iFinishedB = 38
> iBudgetedR = 39
> iBudgetedG = 40
> iBudgetedB = 41
> iTickGray = 42
> ReDim dblXAxisValues(varInput(iNumberOfAxisTicks)) As Double
> ReDim dblTickX(varInput(iNumberOfAxisTicks)) As Double
> For I = 1 To varInput(iNumberOfAxisTicks)
> dblXAxisValues(I) = varInput(iXValueMin) + (I - 1) * (varInput
> (iXValueMax) - varInput(iXValueMin)) / (varInput(iNumberOfAxisTicks) -
> 1)
> dblTickX(I) = varInput(iBarAreaOriginX) + varInput(iBarAreaWidth) *
> (I - 1) / (varInput(iNumberOfAxisTicks) - 1)
> Next I
> strCR = Chr(13)
> strTemp = "%Bullet Graph" & strCR
> strTemp = strTemp & "q" & strCR
> 'Draw the gray rectangles
> 'strTemp = strTemp & "" & strCR
> strTemp = strTemp & "q" & strCR
> strTemp = strTemp & "0.01 w" & strCR
> strTemp = strTemp & varInput(iGray3Color) & " g" & strCR 'fill color
> strTemp = strTemp & varInput(iGray3Color) & " G" & strCR 'border color
> 'strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
> (iBarAreaOriginY) & " " & varInput(iBarAreaWidth) & " " & varInput
> (iBarAreaHeight) & " re" & strCR
> 'Allow the lightest gray background to go beyond the last tick mark
> strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
> (iBarAreaOriginY) & " " & ValToPts(CDbl(varInput(iGray3Value)), CDbl
> (varInput(iXValueMin)), CDbl(varInput(iXValueMax)), CDbl(varInput
> (iBarAreaWidth))) & " " & varInput(iBarAreaHeight) & " re" & strCR
> strTemp = strTemp & "b S" & strCR
> strTemp = strTemp & "Q" & strCR
> strTemp = strTemp & "q" & strCR
> strTemp = strTemp & "0.01 w" & strCR
> strTemp = strTemp & varInput(iGray2Color) & " g" & strCR
> strTemp = strTemp & varInput(iGray2Color) & " G" & strCR
> strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
> (iBarAreaOriginY) & " " & ValToPts(CDbl(varInput(iGray2Value)), CDbl
> (varInput(iXValueMin)), CDbl(varInput(iXValueMax)), CDbl(varInput
> (iBarAreaWidth))) & " " & varInput(iBarAreaHeight) & " re" & strCR
> strTemp = strTemp & "b S" & strCR
> strTemp = strTemp & "Q" & strCR
> strTemp = strTemp & "q" & strCR
> strTemp = strTemp & "0.01 w" & strCR
> strTemp = strTemp & varInput(iGray1Color) & " g" & strCR
> strTemp = strTemp & varInput(iGray1Color) & " G" & strCR
> strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
> (iBarAreaOriginY) & " " & ValToPts(CDbl(varInput(iGray1Value)), CDbl
> (varInput(iXValueMin)), CDbl(varInput(iXValueMax)), CDbl(varInput
> (iBarAreaWidth))) & " " & varInput(iBarAreaHeight) & " re" & strCR
> strTemp = strTemp & "b S" & strCR
> strTemp = strTemp & "Q" & strCR
> 'Draw the ticks and X-Axis numbers
> For I = 1 To varInput(iNumberOfAxisTicks)
> strTemp = strTemp & "q" & strCR
> strTemp = strTemp & "0.01 w" & strCR
> strTemp = strTemp & varInput(iTickGray) & " g" & strCR 'fill color
> strTemp = strTemp & varInput(iTickGray) & " G" & strCR 'border color
> strTemp = strTemp & CStr(dblTickX(I) - varInput(iTickWidth) / 2) & "
> " & varInput(iBarAreaOriginY) - varInput(iTickHeight) & " " & varInput
> (iTickWidth) & " " & varInput(iTickHeight) & " re" & strCR
> strTemp = strTemp & "b S" & strCR
> strTemp = strTemp & "Q" & strCR
> strTemp = strTemp & "BT" & strCR
> intFontNumber = GetFontNumber(CStr(varInput(iXAxisFont)))
> strTemp = strTemp & "/F" & CStr(intFontNumber) & " " & CStr(varInput
> (iXAxisFontSize)) & " Tf" & strCR
> strTemp = strTemp & dblTickX(I) - GetFontWidth(Format(dblXAxisValues
> (I), "0"), CStr(varInput(iXAxisFont)), CDbl(varInput
> (iXAxisFontSize))) / 2 & " " & varInput(iBarAreaOriginY) - varInput
> (iTickHeight) - 4 - varInput(iXAxisFontSize) * 0.85 & "1 Td" & strCR
> strTemp = strTemp & "(" & Format(dblXAxisValues(I), "0") & ") Tj" &
> strCR
> strTemp = strTemp & "ET" & strCR
> Next I
> 'Draw the captions
> strTemp = strTemp & "BT" & strCR
> intFontNumber = GetFontNumber(CStr(varInput(iMainCaptionFont)))
> strTemp = strTemp & "/F" & CStr(intFontNumber) & " " & CStr(varInput
> (iMainCaptionFontSize)) & " Tf" & strCR
> strTemp = strTemp & CStr(varInput(iMainCaptionOriginX)) & " " & CStr
> (varInput(iMainCaptionOriginY)) & "1 Td" & strCR
> strTemp = strTemp & "(" & TLit(CStr(varInput(iMainCaption))) & ") Tj"
> & strCR
> strTemp = strTemp & "ET" & strCR
> strTemp = strTemp & "BT" & strCR
> intFontNumber = GetFontNumber(CStr(varInput(iSubCaptionFont)))
> strTemp = strTemp & "/F" & CStr(intFontNumber) & " " & CStr(varInput
> (iSubCaptionFontSize)) & " Tf" & strCR
> strTemp = strTemp & CStr(varInput(iSubCaptionOriginX)) & " " & CStr
> (varInput(iSubCaptionOriginY)) & "1 Td" & strCR
> strTemp = strTemp & "(" & TLit(CStr(varInput(iSubCaption))) & ") Tj" &
> strCR
> strTemp = strTemp & "ET" & strCR
> 'Draw the projected bar
> strTemp = strTemp & "q" & strCR
> strTemp = strTemp & "0.01 w" & strCR
> strTemp = strTemp & varInput(iProjectedR) & " " & varInput
> (iProjectedG) & " " & varInput(iProjectedB) & " rg" & strCR
> strTemp = strTemp & varInput(iProjectedR) & " " & varInput
> (iProjectedG) & " " & varInput(iProjectedB) & " RG" & strCR
> strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
> (iBarAreaOriginY) + varInput(iBarAreaHeight) / 2 - varInput
> (iThermometerHeight) / 2 & " " & ValToPts(CDbl(varInput
> (iProjectedValue)), CDbl(varInput(iXValueMin)), CDbl(varInput
> (iXValueMax)), CDbl(varInput(iBarAreaWidth))) & " " & varInput
> (iThermometerHeight) & " re" & strCR
> strTemp = strTemp & "b S" & strCR
> strTemp = strTemp & "Q" & strCR
> 'Draw the finished bar
> strTemp = strTemp & "q" & strCR
> strTemp = strTemp & "0.01 w" & strCR
> strTemp = strTemp & varInput(iFinishedR) & " " & varInput(iFinishedG)
> & " " & varInput(iFinishedB) & " rg" & strCR
> strTemp = strTemp & varInput(iFinishedR) & " " & varInput(iFinishedG)
> & " " & varInput(iFinishedB) & " RG" & strCR
> strTemp = strTemp & varInput(iBarAreaOriginX) & " " & varInput
> (iBarAreaOriginY) + varInput(iBarAreaHeight) / 2 - varInput
> (iThermometerHeight) / 2 & " " & ValToPts(CDbl(varInput
> (iFinishedValue)), CDbl(varInput(iXValueMin)), CDbl(varInput
> (iXValueMax)), CDbl(varInput(iBarAreaWidth))) & " " & varInput
> (iThermometerHeight) & " re" & strCR
> strTemp = strTemp & "b S" & strCR
> strTemp = strTemp & "Q" & strCR
> 'Draw the budgeted mark
> strTemp = strTemp & "q" & strCR
> strTemp = strTemp & "0.01 w" & strCR
> strTemp = strTemp & varInput(iBudgetedR) & " " & varInput(iBudgetedG)
> & " " & varInput(iBudgetedB) & " rg" & strCR
> strTemp = strTemp & varInput(iBudgetedR) & " " & varInput(iBudgetedG)
> & " " & varInput(iBudgetedB) & " RG" & strCR
> strTemp = strTemp & varInput(iBarAreaOriginX) + ValToPts(CDbl(varInput
> (iBudgetedValue)), CDbl(varInput(iXValueMin)), CDbl(varInput
> (iXValueMax)), CDbl(varInput(iBarAreaWidth))) - CDbl(varInput
> (iBudgetedBarWidth)) / 2 & " " & varInput(iBarAreaOriginY) + varInput
> (iBarAreaHeight) / 2 - varInput(iBudgetedBarHeight) / 2 & " " &
> varInput(iBudgetedBarWidth) & " " & varInput(iBudgetedBarHeight) & "
> re" & strCR
> strTemp = strTemp & "b S" & strCR
> strTemp = strTemp & "Q" & strCR
> DrawHorizontalBulletGraph = strTemp
> End Function
>
> Private Function ValToPts(dblV As Double, dblMinValue As Double,
> dblMaxValue As Double, dblRangePts As Double) As Double
> ValToPts = dblV * dblRangePts / (dblMaxValue - dblMinValue)
> End Function
>
> Function TLit(strIn As String) As String
> Dim strTemp As String
> Dim intI As Integer
> Dim strChar As String
>
> 'Transform Literals
> TLit = ""
> If Len(strIn) = 0 Then Exit Function
> For intI = 1 To Len(strIn)
> strChar = Mid(strIn, intI, 1)
> Select Case strChar
> Case "\":
> strTemp = strTemp & "\\"
> Case "(":
> strTemp = strTemp & "\("
> Case ")":
> strTemp = strTemp & "\)"
> Case Else
> strTemp = strTemp & strChar
> End Select
> Next intI
> TLit = strTemp
> End Function
>
> Public Function GetFontNumber(strFontName) As Integer
> Select Case strFontName
> Case "Courier":
> GetFontNumber = 1
> Case "CourierBold":
> GetFontNumber = 2
> Case "Helvetica":
> GetFontNumber = 3
> Case "HelveticaBold":
> GetFontNumber = 4
> Case Else
> GetFontNumber = 0
> End Select
> End Function
> 'End Module Code
>
> That should produce a layout text file that can be imported into the
> PDFLayoutViewer I posted and used to create a PDF (The existing
> Portrait mode is adequate). I put a bunch of controls on the form so
> that I can test the function further, but haven't gotten around to
> hooking the array values up to the form controls yet. The PDF ellipse
> code I posted not long ago can be incorporated to make an elliptical
> marker if you really want to make an impression. Inside a report loop
> it is only necessary to change a few array elements once the array
> defaults are set up. I have created some functions that center or
> justify text and automatically scale the text to fit, but those
> haven't been added yet either. Those functions allow me to replace
> the five or six lines of text creation code with a single function
> call. My idea for a job report is to use different colors for the
> thermometer part depending on whether the job is on budget, leaning
> toward being over budget (projected goes past the marker) or actually
> over budget (actual goes past the marker - guess what color I'll use
> for that). That should at least get you going on your worthy
> endeavor.
>
> James A. Fortune
> (E-Mail Removed)