I'm creating many chart objects in a sheet via MS Access VBA.
After I create them, I'm looping through the .Shapes collection and assigning
each one a position/size.
Since I need to populate a few ranges of cells between the charts, I'd like to
place the charts on exact row/column boundaries - so I can keep track of where
they are and place the range/cell data accordingly.
To that end, I'm grabbing a typical cell and capturing it's .Height and .Width
and then sizing/spacing the charts in even increments of those values.
Close... but no cigar.
The charts are coming up just a teeeeeeny bit off on both height and width.
The height discrepancy is about two percent.
I tried coding a fudge factor, but it seems tb a moving target.
Tried processing .ChartObjects instead of .Shapes, but no change.
Am I trying to fool Mother Nature? i.e. is there something going on with the
object dimensions that I cannot control?
Problem code:
------------------------------------------------------
Private Sub entityCharts_Arrange(ByVal theWorkSheetName As String, ByVal
theNumberOfChartsAcrossPage As Long, ByRef theSS As Excel.Application)
3000 debugStackPush mModuleName & ": entityCharts_Arrange"
3001 On Error GoTo entityCharts_Arrange_err
' PURPOSE: To position and size all the charts in a given worksheet
' ACCEPTS: - Name of worksheet whose charts we are to arrange
' - Number of charts we want to see horizontally across the page
' - Pointer to application object of the spreadsheet in question
'
' NOTES: 1) The zinger is that the charts are not spread uniformly.
' Instead, after Amount and Market Value, we need some
' extra space to slip in a little range of data for each.
' Hence ..Pad_Height_Counts and ..._Other.
' Basically, we want to allocate N rows worth of space.
3002 Dim i As Long
Dim myChartCount As Long
Dim myPadHeight As Long
Dim mySingleRowHeight As Long
Dim mySingleColWidth As Long
Dim myChartWidth As Long
Dim myChartHeight As Long
Dim myTitleHeight As Long
Const myPadWidth As Long = 50
Const myRowsToSkipForDataRange As Long = 15
Const myRowsPerChart As Long = 16
Const myColsPerChart As Long = 6
' Const myFudgeFactor_Height As Double = 0
3010 theSS.Worksheets(theWorkSheetName).Select
3019 myChartCount = theSS.ActiveSheet.ChartObjects.Count
' ------------------------------------
' Capture height of title cell at the top of the report
3020 With theSS.ActiveSheet.Cells(1, 1)
3011 myTitleHeight = .Height
3029 End With
' ------------------------------------
' Capture height/width from a typical cell
' (i.e. anything that's not part of the title...)
3030 With theSS.ActiveSheet.Cells(3, 1)
3032 mySingleColWidth = .Width
3033 mySingleRowHeight = .Height
3039 End With
' ------------------------------------
' Set desired height/width of the chart objects
' in even row/column amounts
3040 myChartWidth = myColsPerChart * mySingleColWidth
3049 myChartHeight = myRowsPerChart * mySingleRowHeight
' ------------------------------------
' Do the deed: loop through the shapes collection
' and assign dimensions/locations
3050 For i = 1 To myChartCount
3060 If (i / theNumberOfChartsAcrossPage) > 2 Then
3061 myPadHeight = mySingleRowHeight * myRowsToSkipForDataRange
3062 Else
3063 myPadHeight = mySingleRowHeight
3069 End If
3070 With theSS.ActiveSheet.ChartObjects(i)
'3070 With theSS.ActiveSheet.Shapes(i)
3071 .Width = myChartWidth
3072 .Height = myChartHeight
3073 .Left = (((i - 1) Mod theNumberOfChartsAcrossPage) * (myChartWidth +
myPadWidth)) + mySingleColWidth
3074 .Top = ((Int((i - 1) / theNumberOfChartsAcrossPage) * (myChartHeight
+ myPadHeight)) + myTitleHeight + mySingleRowHeight)
3079 End With
3099 Next i
3999 theSS.ActiveSheet.Cells(3, 3).Select 'So user doesn't see an
arbitrarily-selected range - it's hiding behind 1s chart
entityCharts_Arrange_xit:
DebugStackPop
On Error Resume Next
Exit Sub
entityCharts_Arrange_err:
BugAlert True, "i='" & i & "'."
Resume entityCharts_Arrange_xit
End Sub
------------------------------------------------------
--
PeteCresswell
|
Similar Threads
