Sub AddChartObject()
Dim myAxis As Axis
Sheets("Sheet4").Select
Range("b2").Select
mOK = True
Do While mOK
If ActiveCell.Offset(0, -1).Value = "" Then
QNumber = ActiveCell.Value
newchart = ActiveCell.Value & "Chart"
ActiveCell.Offset(0, -1).Value = "X"
ActiveCell.Offset(0, 1).Select
mRow = ActiveCell.Row
mCol1 = ActiveCell.Column
mRowAbs = ActiveCell.Address
Selection.End(xlToRight).Select
mCol = ActiveCell.Column
mOK = False
Else
ActiveCell.Offset(2, 0).Select
End If
Loop
bAddr = Cells(mRow + 1, mCol).Address
Range(Cells(mRow, mCol1), Cells(mRow + 1, mCol)).Select
' get the ranges for the data for the category labels
Select Case QNumber
Case "Q1", "Q2", "Q3", "Q4", "Q10", "Q12"
mRange = "Sheet2!C1:Sheet2!C2"
Case "Q5"
mRange = "Sheet2!C1:Sheet2!C3"
Case "Q6"
mRange = "Sheet2!C11:Sheet2!C14"
Case "Q7"
mRange = "Sheet2!C4:Sheet2!C7"
Case "Q8a", "Q8b", "Q8c", "Q8d", "Q8e", "Q8f", "Q8g", "Q9a", "Q9b", "Q9c", "Q9d", "Q11a", "Q11b", "Q11c"
mRange = "Sheet2!C8:Sheet2!C10"
Case Else
End Select
' get the title of the graph
mTitle = "Sheet3!b31"
'
Charts.Add
ActiveChart.SetSourceData Source:=Range("'Sheet4'!" & mRowAbs & ":" & bAddr)
ActiveChart.ChartType = xlColumnClustered
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=newchart
'==================================================================================================
'
' First part - set up the labels on the x axis
'
'==================================================================================================
Set myAxis = ActiveChart.Axes(xlCategory, xlPrimary)
With myAxis
.HasMajorGridlines = False
.HasTitle = False
.CategoryNames = Range(mRange)
End With
' this should change the label for the x axis information
With ActiveChart.Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 16
.ColorIndex = xlAutomatic
End With
' =========================
Set oSht = Sheets("Sheet3")
strSearch = Mid(QNumber, 2, Len(QNumber) - 1)
Set aCell = oSht.Range("A24:B46" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
cellRowNumber = aCell.Row
mTitleInfo = Worksheets("Sheet3").Cells(cellRowNumber, 2).Value
End If
'==========================
With ActiveChart
If Len(Title) <> 0 Then
.HasTitle = False
Else
.HasTitle = True
.ChartTitle.Characters.Text = Worksheets("Sheet3").Cells(cellRowNumber, 2).Value
End If
End With
Set newchart = ActiveChart
newchart.SeriesCollection(1).ApplyDataLabels _
AutoText:=True, _
LegendKey:=False, _
ShowSeriesName:=False, _
ShowCategoryName:=False, _
ShowValue:=True, _
ShowPercentage:=False, _
ShowBubbleSize:=False
newchart.SeriesCollection(2).ApplyDataLabels _
AutoText:=True, _
LegendKey:=False, _
ShowSeriesName:=False, _
ShowCategoryName:=False, _
ShowValue:=True, _
ShowPercentage:=False, _
ShowBubbleSize:=False
ActiveChart.SeriesCollection(2).Interior.ColorIndex = 41
mChartColor = ActiveChart.SeriesCollection(2).Interior.Color
newchart.SeriesCollection(1).DataLabels.NumberFormat = "0"
newchart.SeriesCollection(1).DataLabels.Font.Size = 40
newchart.SeriesCollection(1).DataLabels.Position = xlLabelPositionInsideBase
newchart.SeriesCollection(1).DataLabels.Font.Color = RGB(255, 255, 255)
newchart.SeriesCollection(1).DataLabels.Font.Bold = True
newchart.SeriesCollection(2).DataLabels.NumberFormat = "0.0%"
newchart.SeriesCollection(2).DataLabels.Font.Size = 20
newchart.SeriesCollection(2).DataLabels.Font.Bold = True
'newchart.SeriesCollection(2).DataLabels.Font.Color = RGB(255, 255, 255)
With ActiveChart.SeriesCollection(1)
.AxisGroup = xlSecondary
End With
ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = 600
ActiveChart.Axes(xlValue, xlSecondary).MajorTickMark = xlNone
ActiveChart.Axes(xlValue, xlSecondary).TickLabelPosition = xlNone
ActiveChart.Axes(xlValue, xlPrimary).Select
Selection.TickLabels.NumberFormat = "0%"
ActiveChart.SeriesCollection(1).Interior.ColorIndex = 41
ActiveChart.SeriesCollection(2).Interior.ColorIndex = 41
End Sub
Bookmarks