'Paste this beeyotch into the VBE, it should be clearer that way
'I have a sneaking suspicion this is only useful to me...
'but FWIW, I am trying to make this:
'(Crappy-fixed-width-or-it's-nonsensical-ascii art follows;
' Paste into your favorite Osborne emulator to see as intended)
'__________________________________
' CHART TITLE '
' Grp A Grp B Grp C '
' _____________________________ '
' | | | | '
' | | * | | '
' | | * * | | '
' | * | * * | * | '
' | * * | * * * | * | '
' | * * | * * * | * * | '
' '---'---|---'---'---|---'---' '
' a a | b b b | c c '
' 1 2 | 1 2 3 | 1 2 '
' ' ' '
' [cht legend goes here] '
'_________________________________'
'
' and damned if it wasn't a chore getting line objects
' (the vertical lines dividing the subgroups of data A, B and C)
' to line up with the tickmarks that help differentiate categories
' (a1,a2)(b1,b2,b3),(c1,c2)
'
http://img523.imageshack.us/my.php?image=clipboard02copyka0.gif
' shows you the tiny little BS all this comes from, it may seem
inconsequential
' but I felt it was unacceptable and unprofessional to put out a
product like this.
'
' So the main point of this:
' I'm using the exact same methods, variables, values
' To draw and place my home-brewed tick marks
' and my dividing lines; so it doesn't matter if I tell Excel to place
a line on 30
' and it places it on 29.972 (check it out sometime, it's brilliantly
frustrating
' because when I place my tickmarks, it will also land on 29.972,
lining up exactly
' with the mark, instead of having to eyeball it everytime
' (and eyeballing it in Excel, especially zoomed, will get you
nowhere, there's some scary
' quantum mechanics type stuff going on; just the act of observing
the line, zoomed,
' changes the placement of the line in the final pdf document. So
instead, lining them up means
' Tweak the line, save the chart, update the link in word, print the
word document to postscript file
' Use Acrobat distiller to make a pdf, open the pdf, zoom to 600%,
see if the divider lines up with your tickmarks
' No? Start over. Repeat until perfect. Now do this for all forty
charts.
' What's that? You need to add a category to the chart? Please start
over from the beginning.
' What's that? You adjusted the size of the plot area? Please start
over from the beginning.
Option Explicit 'Indicates variable naming convention includes
probable usage of profanity
Dim divLineOrigHorizPos() As Double
Dim divLineHorizontalPos As Double
Dim tckMkHorizontalPos As Double
'The following are all variables to store various chart coordinates,
not sure I even use them all
Dim chtCategoryCount As Double, chtCategorySpacing As Double
'Oh , this just in: I assume a legend placement on the bottom
Dim chtLegendHeight As Double, chtLegendLeft As Double, chtLegendWidth
As Double, chtLegendTop As Double
'More coordinate variables; the "g" prefix was my way of
distinguishing between the normal and the ExecuteExcel4Macro
~~~G~~~ET.CHART.ITEM
'coordinates, while I was experimenting with and comparing both (they
were often 'off' by a half a point)
'Also, interestingly, the .Height/.Width/.Left/.Top methods always
returned an integer, thought that was a bit peculiar
Dim gchtPlotAreaInsideLeft As Double, gchtPlotAreaInsideWidth As
Double, gchtPlotAreaInsideRight As Double
Dim gchtPlotAreaInsideTop As Double, gchtPlotAreaInsideHeight As
Double, gchtPlotAreaInsideBottom As Double
Dim gchtChartAreaLeft As Double, gchtChartAreaWidth As Double,
gchtChartAreaTop As Double, gchtChartAreaHeight As Double
Dim cht As Chart
Dim origChtName As String
Dim shp As Shape
Dim n As Integer 'Dividing Positions
'A chart with 3 category labels has 4 dividing
positions -
'Left side of PlotArea, between 1&2, 2&3 and
Right side of PlotArea
Dim nTot As Integer 'Total number of dividing positions
Dim s As Integer
Dim d As Integer 'Dividing Lines
Dim dTot As Integer 'Total number of dividing lines
Dim tckMkName As String
Dim divLineName As String
Sub zAddTicksAndDividingChartLines()
'I work with chart sheets, not charts on worksheets,
'I'm sure you'd need to tweak this if that's your chart MO
origChtName = ActiveChart.Name 'You have the chart you're working on
already selected
Set cht = Charts(origChtName)
cht.PageSetup.Zoom = 100 'This is some superstitious voodoo to ward
off unpredictable PointsToPixels black magic
cht.Axes(xlCategory).MajorTickMark = xlNone 'Turn 'em off, they'll
only confuse you
cht.Axes(xlCategory).MinorTickMark = xlNone
chtCategoryCount = cht.SeriesCollection(1).Points.Count ' number of
categories; tick marks and dividers fall in between them
chtLegendHeight = cht.Legend.Left 'could have done this with
ExecuteExcel4Macro("GET.CHART.ITEM(1, 7,""Legend"")"), got lazy
chtLegendLeft = cht.Legend.Height 'especially since these are not
vital to my accuracy, I use them to estimate
chtLegendWidth = cht.Legend.Width 'an approximate appropriate length
for my dividing lines
chtLegendTop = cht.Legend.Top
chtLegendHeight = cht.Legend.Height
'Measures from lower Left Corner!!! (Meaning Y-values must be
converted)
gchtChartAreaLeft = ExecuteExcel4Macro("GET.CHART.ITEM(1,
7,""Chart"")") ' (1,7 = Horizontal Coordinate, Lower Left)
gchtChartAreaWidth = ExecuteExcel4Macro("GET.CHART.ITEM(1,
5,""Chart"")")
' don't have to convert, since it's the following two, though they are
y-values, because they are total measurements of chart size
gchtChartAreaTop = ExecuteExcel4Macro("GET.CHART.ITEM(2,
7,""Chart"")") ' (2,7 = Vertical Coordinate, Lower Left)
gchtChartAreaHeight = ExecuteExcel4Macro("GET.CHART.ITEM(2,
1,""Chart"")") '(2,1 = Vertical Coordinate, Upper Left)'don't have to
convert
'Incidentally, if this had not worked, I would've used
ExecuteExcel4Macro("GET.CHART.ITEM... to return the values of
individual plot objects
' and then calculated the middle of them by averaging;
'Find the XY position of the middle top of the third column
'in the data series,
'returned in XLM coordinates
'tckMk3 = (ExecuteExcel4Macro("GET.CHART.ITEM(1,2,""S1P3"")") +
ExecuteExcel4Macro("GET.CHART.ITEM(1,2,""S1P4"")"))/2
'(Series one point 3, horizontal center position)+(series one point 4,
horizontal center)/2 is where the tick should be
'~~~~~~~~~~~~~~~~~~~~~~~
'Notice that "-2" and -"1" snuck in there? That's where you still end
up doing some guesswork and manual tweaking
'"-2" (points) is what it took to exactly line up my first tickmark
with the Y-Axis in practice
'I suppose I could create variables for these tweaks,
'Dim wysiwygMyAss1 As Double, wysiwygMyAss2 As Double
gchtPlotAreaInsideLeft = ExecuteExcel4Macro("GET.CHART.ITEM(1,
7,""Plot"")") - 2 ' (1,7 = Horizontal Coordinate, Lower Left)
gchtPlotAreaInsideRight = ExecuteExcel4Macro("GET.CHART.ITEM(1,
5,""Plot"")") - 1 ' (1,5 = Horizontal Coordinate, Lower Right)
gchtPlotAreaInsideWidth = gchtPlotAreaInsideRight -
gchtPlotAreaInsideLeft
'~~~~~~~~~~~~~~~~~~~~~~~
'Convert the XLM coordinates to Drawing Object coordinates
'The x values are the same, but the Y values need to be
'flipped converting to make measurements originate from upper left
which matches VBA measurements
gchtPlotAreaInsideBottom = gchtChartAreaHeight -
ExecuteExcel4Macro("GET.CHART.ITEM(2, 7,""Plot"")") + 1 '+ 0.75 ' (2,7
= Vertical Coordinate, Lower Left)
gchtPlotAreaInsideTop = gchtChartAreaHeight -
ExecuteExcel4Macro("GET.CHART.ITEM(2, 1,""Plot"")") ' (2,1 = Vertical
Coordinate, Upper Left)
gchtPlotAreaInsideHeight = gchtPlotAreaInsideBottom -
gchtPlotAreaInsideTop
'divides the width of the chart, by the number of cats
'a 100 pt wide chart with ten categories will place your tickmarks
every 10 pts (in theory, look for minor adjustments)
chtCategorySpacing = (gchtPlotAreaInsideWidth) / chtCategoryCount
'The next are a series of functions to help keep this subroutine clean
'I like using "Call" it helps remind me I'm not looking at another
variable
'Dumb thing about this, gotta fix it:
'Should add something that makes a quick copy of the original chart
sheet
'And preserves it until you're certain everything went "as planned"
'Stopping in the middle to troubleshoot can mean losing your
divLineOrigHorizPos() data
'And your original dividing lines
'~~~~~~~~~~~~~~~~~~~~~~~
'1) properly label any dividing lines -
'If I have run the routine before, they'll be named divLineXX,
'where XX is the sequential number of the left-most category
'otherwise, if I have just designed the chart from scratched,
'they'll be renamed from the default Line1, Line2 etc. to my format
Call LabelDivLines
'~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~
'2) Count the number of dividers in the chart by calling this function
'and use that number to assign the proper # in the array
divLineOrigHorizPos()
'divLineOrigHorizPos is an array soon to be populated with the
horizontal (x-value)
'position of all the dividing lines, from 1 to dTot
'Why? I cannot accurately reposition a line (pixel to point weirdness
going on here?),
'but I can delete the old one and create a new one in a more exact (or
replicable) position
dTot = CountDivLines()
ReDim Preserve divLineOrigHorizPos(1 To dTot)
'~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~
'3) Clear old dividers from chart before redraw
Call DelOldDivLines
'~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~
'4) Clear any old 'tickmark' shapes from chart before redraw
Call DelOldTickMarks
'~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~
'5) Add new 'tickmark' shapes
Call AddTickMarks
'~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~
' 6) Add new dividers
Call AddDividingLines
'~~~~~~~~~~~~~~~~~~~~~~~
End Sub
Function LabelDivLines() As Integer
'In case we haven't named our dividers yet, we go through and rename
n = 50 ' I never have this many real lines, so this is a way to avoid
duplicate naming with my temporarily labeled lines;
'They will be relabeled later with respect to their relative category
divider position.
For Each shp In cht.Shapes
If Left(shp.Name, 4) = "Line" Then 'Anything named "Line"
If Abs((gchtPlotAreaInsideTop) - shp.Top) < 4 Then 'with the top
near the top of the PlotArea
If shp.Height > gchtPlotAreaInsideHeight Then 'with a height
greater than the PlotArea
shp.Name = "divLine" & n 'Is renamed as "divLine" & a
dummy number
n = n + 1
End If
End If
End If
Next shp
n = 0
End Function
Function CountDivLines() As Integer
'Counts the number of dividers
'Dividers are the long vertical lines to divide the category axis into
sub-categories
dTot = 0
For Each shp In cht.Shapes 'Get total of all the dividing for a given
chart
If Left(shp.Name, 7) = "divLine" Then
dTot = dTot + 1
End If
Next shp
CountDivLines = dTot
End Function
Function DelOldDivLines()
'Remove old Dividing lines before redraw
'But note their horizontal position in the array divLineOrigHorizPos()
'So they can be recreated later
d = 1
For Each shp In cht.Shapes
If Left(shp.Name, 7) = "divLine" Then
divLineOrigHorizPos(d) = shp.Left
d = d + 1
shp.Delete
End If
Next shp
End Function
Function DelOldTickMarks()
' If I were to get my act together, I'd select all the tckMks
' and add them into one group; easier to delete, easier to manipulate/
adjust
For Each shp In cht.Shapes
If Left(shp.Name, 5) = "tckMk" Then
shp.Delete
End If
Next shp
End Function
Function AddTickMarks()
For n = 0 To chtCategoryCount ' n = 0 is tick under y-axis;
chtCategoryCount is rightmost tick
' I like it when things will alphabetize,
' This way if I ever use the vars in a list, it goes
' tckMk01, tckMk02 ... tckMk09, tckMk10, tckMk11
' instead of
' tckMk1, tckMk10, tckMk11 ... tckMk19, tckMk2, tckMk20, tckMk21
tckMkName = "tckMk" & Right(n + 100, 2)
' chtCategorySpacing is that 10 pt width of each category
' So if we are at the 6th divider, the tickmark would be located at
' 60 points to the right of the leftmost edge of the PlotArea
tckMkHorizontalPos = ((chtCategorySpacing * n) +
gchtPlotAreaInsideLeft) 'n=0 is the leftmost tickmark, cancels out
'seemed easiest to name it right here, so I could refer to it easily
ActiveChart.Shapes.AddLine(tckMkHorizontalPos,
gchtPlotAreaInsideBottom, _
tckMkHorizontalPos,
gchtPlotAreaInsideBottom + 3).Name = tckMkName
' "+3" was a good facsimile of the length of a regular tickmark (for
my particular chart size)
' but if I wanted to help separate my categories better
'(I usu. use vertically oriented text)
' I'd go ahead and make it longer
cht.Shapes(tckMkName).Placement = xlMove
With cht.Shapes(tckMkName).Line
.DashStyle = msoLineSolid
.Style = msoLineSingle
.Weight = 0.75
.ForeColor.RGB = RGB(0, 0, 0)
End With
Next n
End Function
Function AddDividingLines()
Dim divLineHeight As Double
Dim divLineName As String
'
'Decided that about 3/4 of the way from the bottom of the PlotArea to
the top of the chart legend
'was a good rule of thumb for the height of the line (added to the
height of the plot area)
divLineHeight = ((chtLegendTop - gchtPlotAreaInsideBottom) * 0.75) +
gchtPlotAreaInsideBottom
For d = 1 To dTot
For n = 0 To chtCategoryCount 'would not likely have dividers on
the edges of the plotarea, but it could happen
divLineHorizontalPos = ((chtCategorySpacing * n) +
gchtPlotAreaInsideLeft)
'here's where we guess which category the provisional
dividing line was supposed to belong to.
'in our hypothetical chart, I would have needed to place the
line correctly
' with a +/- 3 pt margin of error, which is reasonably
generous
If Abs(divLineHorizontalPos - divLineOrigHorizPos(d)) <
(chtCategorySpacing / 3) Then
divLineName = "divLine" & Right(n + 100, 2)
ActiveChart.Shapes.AddLine(divLineHorizontalPos,
gchtPlotAreaInsideTop, _
divLineHorizontalPos,
divLineHeight).Name = divLineName
ActiveChart.Shapes(divLineName).Placement = xlMove 'hate
anything that tries to "Size with Chart" - nothing will ruin your day
faster
n = chtCategoryCount
End If
Next n
Next d
End Function