Thermometer Chart
Public ch As ChartObject, sh As Worksheet
Function DefineWorksheet()
Set sh = ThisWorkbook.Sheets("CreateChart_VBA")
sh.Activate
Application.ActiveWindow.DisplayGridlines = False
End Function
Function Createchart()
With sh.Range("D2:L18")
Set ch = sh.ChartObjects.Add( _
Height:=.Height, _
Top:=.Top, _
Left:=.Left, _
Width:=.Width)
End With
End Function
Sub CreateChrat()
DefineWorksheet
Createchart
With ch.Chart
.ChartType = xlColumnClustered
'=================Series Collection 1 ==========Standard====
.SeriesCollection.NewSeries
Dim Standard As Series
Set Standard = .SeriesCollection(1)
Standard.Name = sh.Range("B1").Value
Standard.Values = sh.Range("B2:B6")
Standard.XValues = sh.Range("A2:A6")
Standard.Interior.ColorIndex = 5
'Standard.HasDataLabels = True
'=================Series Collection 2==Actual ===========
.SeriesCollection.NewSeries
Dim Actual As Series
Set Actual = .SeriesCollection(2)
Actual.Name = sh.Range("C1").Value
Actual.Values = sh.Range("C2:C6")
'Actual.XValues = sh.Range("B5:B9")
Actual.Interior.ColorIndex = 30
'=======Overlap Actual into Standard==================
Actual.Select
'ActiveChart.FullSeriesCollection(2).Select
ActiveChart.ChartGroups(1).Overlap = 100
ActiveChart.FullSeriesCollection(1).Select
Selection.Format.Fill.Visible = msoFalse
Actual.Format.Line.Visible = msoFalse
Standard.Format.Line.Weight = 2.5
Standard.Format.Line.Visible = msoTrue
Standard.Format.Line.ForeColor.RGB = RGB(192, 0, 0)
'.Legend.Position = xlLegendPositionRight
'==============DataLabels===================
Dim S As Series
For i = 1 To .SeriesCollection.Count
Set S = .SeriesCollection(i)
S.HasDataLabels = True
S.ApplyDataLabels xlDataLabelsShowValue
Dim DataLble As DataLabels
Set DataLble = S.DataLabels
DataLble.Font.Size = 11
DataLble.Font.Bold = True
DataLble.Font.Name = "Calibri"
DataLble.Orientation = xlHorizontal
If i = 1 Then
DataLble.Position = xlLabelPositionOutsideEnd
DataLble.Font.ColorIndex = 5
Else:
DataLble.Position = xlLabelPositionCenter
DataLble.Font.ColorIndex = 2
End If
Next
'===============Chart Title===============
'Chart Title
.HasTitle = True
Dim t As ChartTitle
Set t = .ChartTitle
t.Text = sh.Range("B1").Value & " - " & sh.Range("C1").Value & " - " & "Sales"
t.Font.ColorIndex = 30
t.Font.Size = 25
t.Font.FontStyle = "Footlight MT Light"
'=====================Legend Position=========
.HasLegend = True
Dim L As Legend
Set L = .Legend
L.Position = xlLegendPositionTop
'=================ChartArea===========
Dim SeriesAxis As Axis
Set SeriesAxis = .Axes(xlValue, xlPrimary)
SeriesAxis.HasTitle = True
SeriesAxis.AxisTitle.Caption = "Sales"
SeriesAxis.AxisTitle.Characters.Font.ColorIndex = 5
SeriesAxis.AxisTitle.Characters.Font.Size = 15
SeriesAxis.AxisTitle.Orientation = 90
SeriesAxis.HasMinorGridlines = False
SeriesAxis.HasMajorGridlines = False
'=================Category axis format===============
Dim CategoryAxis As Axis
Set CategoryAxis = .Axes(xlCategory)
CategoryAxis.HasTitle = True
CategoryAxis.AxisTitle.Caption = "Items"
CategoryAxis.AxisTitle.Characters.Font.ColorIndex = 5
CategoryAxis.AxisTitle.Characters.Font.Size = 15
'=======Category axis TickLabels=================
Dim CategoryAxisTK As TickLabels
Set CategoryAxisTK = .Axes(xlCategory).TickLabels
CategoryAxisTK.Font.ColorIndex = 5
CategoryAxisTK.Orientation = 45
End With
ch.Name = "SalesData"
sh.Range("A1").Select
End Sub