Module for automatic spreadsheet formatting and chart generation in Excel.
Public Sub ChartAll()
On Error GoTo Handler
Worksheets.Add before:=Worksheets(1)
Sheets(1).Name = "Summary"
Sheets(1).Activate
'Application.ScreenUpdating = False
' Fix issue with invalid data type to MakeArray
Dim strSheetName As String
' end fix
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim strRange As Variant
Dim iColumn As Long
Dim i, y As Long
Dim intColStart As Integer
Dim lastrow As Integer
Dim lastcolumn As Integer
Dim ws As Variant
Dim arrSpreadSheet
For i = 2 To Worksheets.Count
Set ws = Sheets(i)
ws.Activate
lastrow = ws.Cells(Rows.Count, "a").End(xlUp).Row
lastcolumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
'Colour Title and Totals
With Range(Cells(1, 1), Cells(1, lastcolumn))
.Interior.ColorIndex = 3
.Interior.Pattern = xlSolid
.Font.ColorIndex = 2
.Font.Bold = True
End With
With Range(Cells(lastrow, 1), Cells(lastrow, lastcolumn))
.Interior.ColorIndex = 3
.Interior.Pattern = xlSolid
.Font.ColorIndex = 2
.Font.Bold = True
End With
ws.Columns.AutoFit
'Freeze title row
ws.Cells(2, 1).Activate
With ActiveWindow
.FreezePanes = False
.FreezePanes = True
End With
' define chart data
'Set rngChtData = ws.Range(Cells(1, 1), Cells(lastrow - 1, lastcolumn - 1))
' Get initial data
' Fix issue with invalid data type to MakeArray
strSheetName = ws.Name
' end fix
arrSpreadSheet = MakeArray(strSheetName)
For y = 0 To UBound(arrSpreadSheet)
If arrSpreadSheet(y, 0) <> "Account" And arrSpreadSheet(y, 0) <> "Site" Then
intColStart = y + 1
Exit For
End If
Next
Sheets(1).Activate
' add the chart
Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=250, Width:=(ActiveWindow.PointsToScreenPixelsX(ActiveWindow.Width) / 3), Top:=75, Height:=(ActiveWindow.PointsToScreenPixelsY(ActiveWindow.Height) / 1.5)) 'old width=375 - old height=225
With myChtObj.Chart
strRange = getAlphaIndex(intColStart) & "1:" & getAlphaIndex(UBound(arrSpreadSheet) + 1) & UBound(arrSpreadSheet, 2)
' Set Source Data
.SetSourceData Source:=Sheets(ws.Name).Range(strRange)
' make an XY chart
.ChartType = xlColumnClustered
' add title
.HasTitle = True
.ChartTitle.Text = ws.Name
End With
'Rest cut to my Docs...
Contloop:
Next i
ArrangeMyCharts
'Application.ScreenUpdating = True
Exit Sub
Handler:
MsgBox "Error: " & Err.Number & vbCrLf & vbcrlrf & Err.Description, vbExclamation, "Format Monthly Reports"
End Sub
Public Sub ChartArrange()
Dim iChart As Long
Dim nCharts As Long
Dim dTop As Double
Dim dLeft As Double
Dim dHeight As Double
Dim dWidth As Double
Dim nColumns As Long
dTop = 10 ' top of first row of charts
dLeft = 10 ' left of first column of charts
dHeight = (ActiveWindow.PointsToScreenPixelsY(ActiveWindow.Height) / 1.7) ' height of all charts
dWidth = (ActiveWindow.PointsToScreenPixelsX(ActiveWindow.Width) / 2.5) ' width of all charts
nColumns = 1 ' number of columns of charts
nCharts = ActiveSheet.ChartObjects.Count
For iChart = 1 To nCharts
With ActiveSheet.ChartObjects(iChart)
.Height = dHeight
.Width = dWidth
.Top = dTop + Int((iChart - 1) / nColumns) * dHeight
.Left = dLeft + ((iChart - 1) Mod nColumns) * dWidth
End With
Next
End Sub