Aligning a chart to cells code

[Isodaur]

Hi Guys,

Been trying to get this to work:

Sub Align_Chart_To_Cells()
Dim max As Integer, j As Double
Dim csh As Shape
Dim chrt As Chart
Dim xx As Axis
Set chrt = ActiveChart
Set csh = ActiveSheet.Shapes(right(chrt.Name, Len(chrt.Name) - Len(ActiveSheet.Name) - 1))
csh.TopLeftCell.Activate
Set xx = chrt.Axes(xlValue, xlPrimary)
csh.left = ActiveCell.left - chrt.Axes(xlCategory).left - 4
csh.Top = ActiveCell.Top
max = InputBox("How Many x axis categories are there?")
Set xx = chrt.Axes(xlCategory)
j = 0
For i = 0 To max - 1
    j = Round((12.75 * 3) / (1.71 * 4), 2)
    ActiveCell.ColumnWidth = (chrt.Axes(xlCategory).Width / max) / j
    ActiveCell.Offset(0, 1).Activate
Next i
End Sub

The idea is to match the category x-axis boundries to cell boundries - secondry axis charts, i put in extra blank data series to align everything (gap and overlap are useless). Data tables show the blank series data so macro to align the thing to cells easier to write a table below it without fiddling with column widths.

Any Ideas?

[Andy Pope]

Can you post example workbook with the chart and cells you are trying to align to?

[Isodaur]

Ok, I've attahched an example. And I commented the code for you too seeing as it was a bit chunky

[Cyberdude]

For what its worth, here are some chart-type utilities that I wrote for myself awhile back. Perhaps there?s something of use to you in them:

Use ?Sub ShowChartTopLeftBottomRightCellAddr_Locator? to execute ?ShowChartTopLeftBottomRightCellAddr? so you can see what it does:

[vba]Sub ShowChartTopLeftBottomRightCellAddr_Locator()
Call ShowChartTopLeftBottomRightCellAddr(31)
End Sub

Sub ShowChartTopLeftBottomRightCellAddr(Optional ChartNo As String = "1")
Dim TopLeftAddr As String, BottomRightAddr As String, Msg As String
Const Title As String = "'Example WorkbookName' (ShowChartTopLeftBottomRightCellAddr)"
On Error GoTo NoneActiveErr

With Worksheets("Chart").ChartObjects(ChartNo)
TopLeftAddr = .TopLeftCell.Address
BottomRightAddr = .BottomRightCell.Address
Range("ChrtTpRow") = .TopLeftCell.Row
End With
On Error GoTo 0

?Output message
Msg = " Position of 'Chart " & ChartNo & "'" & vbCr & vbCr & _
"The chart's top left corner is" & vbCr & _
"over cell '" & TopLeftAddr & "'." & vbCr & vbCr & _
"The chart's bottom right corner is" & vbCr & _
"over cell '" & BottomRightAddr & "'."
MsgBox Msg, , Title
GoTo Finish

NoneActiveErr:
Msg = "'Chart " & ChartNo & "' on sheet '" & ActiveSheet.Name & "' is not active now." & vbCr & vbCr & _
"Make sure that the correct sheet is selected, then" & vbCr & _
"click anywhere on the chart to make it active."
MsgBox Msg, vbCritical, Title

Finish:
End Sub 'ShowChartTopLeftBottomRightCellAddr'[/vba] Here?s some more:
[vba]Sub GetChrtTopRow_Locator()
MsgBox ?Chart?s Top Row is: ? & GetChrtTopRow(1)
End Sub

Function GetChrtTopRow(Optional ChartNo As String = "1") As String
GetChrtTopRow = Worksheets("Chart").ChartObjects(ChartNo).TopLeftCell.Row
End Function 'GetChrtTopRow'[/vba]
And this . . .
[vba]Sub ShowActiveChartName()
Dim ChrtNm As String, Msg As String
Const Title As String = "''Example WorkbookName'' (ShowActiveChartName)"

'Use this macro to determine a chart's name (Index) in the format:
' WorksheetName "Chart" ChartIndex
'Example output: Miscell Chart 8
'The chart must be pre-selected before running this macro.

On Error GoTo NoneActiveErr
ChrtNm = ActiveChart.Name
ChrtNm = Right(ChrtNm, Len(ChrtNm) - 6)
On Error GoTo 0
Msg = "The currently active chart" & vbCr & _
"on Worksheet '" & ActiveSheet.Name & "' is:" & vbCr & _
" '" & ChrtNm & "'"
MsgBox Msg, , Title
GoTo Finish

NoneActiveErr:
Msg = "No chart is active now." & vbCr & _
"Click anywhere on the chart to make it active."
MsgBox Msg, vbCritical, Title

Finish:
End Sub 'ShowActiveChartName'[/vba]
And some more:
[vba]Sub ShowChartElementIDVal()
Dim IDNum As Long
MsgBox "xlAxis = " & xlAxis & vbCr & _
"xlAxisTitle = " & xlAxisTitle & vbCr & _
"xlChartTitle = " & xlChartTitle & vbCr & _
"xlSeriesLines = " & xlSeriesLines & vbCr & _
"xlMajorGridlines = " & xlMajorGridlines & vbCr & _
"xlLegend = " & xlLegend & vbCr & _
"xlChartArea = " & xlChartArea & vbCr & _
"xlCorners = " & xlCorners & vbCr & _
"xlSeries = " & xlSeries
End Sub 'ShowChartElementIDVal'[/vba]
?MoveChartVert_Locator? is the test driver for ?MoveChartVert? below
[vba]Sub MoveChartVert_Locator()
Dim ShtNm As String, ChartIdx As Integer, VertPoints As Single, Cnt As Single
ChartIdx = 1
Cnt = -1
VertPoints = 15.6 * Cnt 'Move chart down
Call MoveChartVert(ChartIdx, VertPoints)
End Sub ?MoveChartVert_Locator?

Sub MoveChartVert(ChartIdx As Integer, Points As Single)
'Make "Points" positive for right shift and negative for left shift
'Make "Points" positive for down shift and negative for up shift
'For veritcal moves, the points seem to agree with the row height
Dim Msg$, ChartID$, ShtNm$
Const Title$ = "'Lortab Chart' (MoveChartVert)"
Application.EnableEvents = True 'Enable ALL event processing
Application.Calculation = xlAutomatic
ShtNm = ActiveSheet.Name
Worksheets("Chart").Select
On Error GoTo ErrMsg
ChartID = "Chart " & ChartIdx

ActiveSheet.ChartObjects(ChartID).Activate
ActiveChart.ChartArea.Select '<--(Error)

ActiveSheet.Shapes(ChartID).IncrementTop Points
If ChartIdx = 1 _
Then Range("ChrtTpRow") = Worksheets("Chart").ChartObjects(1).TopLeftCell.Row
On Error GoTo 0
GoTo Finish

ErrMsg:
Msg = "Unknown error '" & Err & "' occurred in macro 'MoveChartVert''" & vbCr & _
Error & vbCr & vbCr & _
"ChartObjects number '" & ChartID & "' was specified." & vbCr & _
"Make sure this ChartID is correct." & vbCr & vbCr & _
"Terminating execution of 'MoveChartVert'" & vbCr & _
"then continuing execution of calling macro."
On Error GoTo 0
MsgBox Msg, vbCritical, Title

Finish:
Worksheets(ShtNm).Select
End Sub 'MoveChartVert'[/vba] Hope there?s something in these that helps (maybe not).