sdmikejr
03-11-2018, 09:31 PM
I have coded a chart that I believe is 90% working, but needs some tweaks. Let me explain.
I have a requirement for a chart template that the user can go in and plot 8 columns of data and they want full control over the x, y axis scales (min / max) chart title and series names.
It appears to be working for the most part, but when I change the min max on the axis between a min / max range that should still show series - it doesn't.
The code is as follows. Can any VBA guru help me out to figure out or identify what code(s) parts aren't working?
Sub CreateChart()
Dim rng As Range
Dim cht As Object
Set rng = Worksheets("Data").Range("B:I")
Set cht = Worksheets("Chart").Shapes.AddChart2
cht.Chart.SetSourceData Source:=rng
cht.Chart.ChartType = xlXYScatterLines
ActiveSheet.ChartObjects(1).Name = "Chart1"
End Sub
Sub AddChartTitle()
Dim cht As ChartObject
Set cht = ActiveSheet.ChartObjects("Chart1")
cht.Chart.HasTitle = True
cht.Chart.ChartTitle.Text = "=Chart!$J$6"
End Sub
'Use User input to scale X and Y Axis
Sub ScaleAxes()
'Select Inactive Chart Object
ActiveSheet.ChartObjects(1).Activate
With Application.ActiveChart.Axes(xlCategory, xlPrimary)
.MinimumScale = ActiveSheet.Range("O6").Value
.MaximumScale = ActiveSheet.Range("O8").Value
.MajorUnit = ActiveSheet.Range("O10").Value
End With
With Application.ActiveChart.Axes(xlValue, xlPrimary)
.MinimumScale = ActiveSheet.Range("N6").Value
.MaximumScale = ActiveSheet.Range("N8").Value
.MajorUnit = ActiveSheet.Range("N10").Value
'Move X axis to bottom of chart
ActiveChart.Axes(xlCategory).TickLabelPosition = xlTickLabelPositionLow
End With
End Sub
Sub AddStuffToChart()
Dim cht As Chart
Set cht = ActiveSheet.ChartObjects("Chart1").Chart
'Add X-axis title
cht.Axes(xlCategory, xlPrimary).HasTitle = True
'Add y-axis title
cht.Axes(xlValue, xlPrimary).HasTitle = True
End Sub
Sub yAxisTitle()
Dim rCell As Range
Set rCell = Range("J8")
With ActiveChart.Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Caption = "=" & rCell.Worksheet.Name & "!" & rCell.Address(ReferenceStyle:=xlR1C1)
End With
End Sub
Sub xAxisTitle()
Dim rCell As Range
Set rCell = Range("J10")
With ActiveChart.Axes(xlCategory, xlCategory)
.HasTitle = True
.AxisTitle.Caption = "=" & rCell.Worksheet.Name & "!" & rCell.Address(ReferenceStyle:=xlR1C1)
End With
End Sub
Sub add_Gridlines()
Dim cht As Chart
' change chart name here
Set cht = Sheets("Chart").ChartObjects("Chart1").Chart
With cht.Axes(xlCategory, xlPrimary)
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(204, 204, 204)
.MajorGridlines.Border.LineStyle = xlContinuous
.MajorGridlines.Border.Weight = xlThin
.HasMinorGridlines = False
End With
With cht.Axes(xlValue, xlPrimary)
.HasMajorGridlines = True
.HasMinorGridlines = False
.MajorGridlines.Border.Color = RGB(204, 204, 204)
.MinorGridlines.Border.LineStyle = xlContinuous
.MinorGridlines.Border.Weight = xlThin
'Remove ChartArea border
cht.ChartArea.Border.LineStyle = xlNone
End With
End Sub
Sub formatAxis()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.Axes(xlValue).AxisTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
ActiveChart.Axes(xlCategory).AxisTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
ActiveChart.ChartTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Selection.Format.TextFrame2.TextRange.Font.UnderlineStyle = _
msoUnderlineSingleLine
End Sub
Sub TitleFont()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Font.Size = 12
End Sub
Sub ChartSize24()
ActiveSheet.ChartObjects("Chart1").Activate
With ActiveChart.Parent
.Height = 205
.Width = 230
End With
End Sub
Sub changeLegendSeries()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.FullSeriesCollection(1).Name = "=Chart!$J$13"
ActiveChart.FullSeriesCollection(2).Name = "=Chart!$J$14"
ActiveChart.FullSeriesCollection(3).Name = "=Chart!$J$15"
ActiveChart.FullSeriesCollection(4).Name = "=Chart!$J$16"
ActiveChart.FullSeriesCollection(5).Name = "=Chart!$J$17"
ActiveChart.FullSeriesCollection(6).Name = "=Chart!$J$18"
ActiveChart.FullSeriesCollection(7).Name = "=Chart!$J$19"
ActiveChart.FullSeriesCollection(8).Name = "=Chart!$J$20"
End Sub
Sub DeleteChart()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.Parent.Delete
End Sub
Sub Button11_Click()
Call Sheet2.CreateChart
Call Sheet2.ScaleAxes
Call Sheet2.AddChartTitle
Call Sheet2.AddStuffToChart
Call Sheet2.add_Gridlines
Call Sheet2.xAxisTitle
Call Sheet2.yAxisTitle
Call Sheet2.formatAxis
Call Sheet2.ChartSize24
Call Sheet2.TitleFont
Call Sheet2.changeLegendSeries
End Sub
21803
I have a requirement for a chart template that the user can go in and plot 8 columns of data and they want full control over the x, y axis scales (min / max) chart title and series names.
It appears to be working for the most part, but when I change the min max on the axis between a min / max range that should still show series - it doesn't.
The code is as follows. Can any VBA guru help me out to figure out or identify what code(s) parts aren't working?
Sub CreateChart()
Dim rng As Range
Dim cht As Object
Set rng = Worksheets("Data").Range("B:I")
Set cht = Worksheets("Chart").Shapes.AddChart2
cht.Chart.SetSourceData Source:=rng
cht.Chart.ChartType = xlXYScatterLines
ActiveSheet.ChartObjects(1).Name = "Chart1"
End Sub
Sub AddChartTitle()
Dim cht As ChartObject
Set cht = ActiveSheet.ChartObjects("Chart1")
cht.Chart.HasTitle = True
cht.Chart.ChartTitle.Text = "=Chart!$J$6"
End Sub
'Use User input to scale X and Y Axis
Sub ScaleAxes()
'Select Inactive Chart Object
ActiveSheet.ChartObjects(1).Activate
With Application.ActiveChart.Axes(xlCategory, xlPrimary)
.MinimumScale = ActiveSheet.Range("O6").Value
.MaximumScale = ActiveSheet.Range("O8").Value
.MajorUnit = ActiveSheet.Range("O10").Value
End With
With Application.ActiveChart.Axes(xlValue, xlPrimary)
.MinimumScale = ActiveSheet.Range("N6").Value
.MaximumScale = ActiveSheet.Range("N8").Value
.MajorUnit = ActiveSheet.Range("N10").Value
'Move X axis to bottom of chart
ActiveChart.Axes(xlCategory).TickLabelPosition = xlTickLabelPositionLow
End With
End Sub
Sub AddStuffToChart()
Dim cht As Chart
Set cht = ActiveSheet.ChartObjects("Chart1").Chart
'Add X-axis title
cht.Axes(xlCategory, xlPrimary).HasTitle = True
'Add y-axis title
cht.Axes(xlValue, xlPrimary).HasTitle = True
End Sub
Sub yAxisTitle()
Dim rCell As Range
Set rCell = Range("J8")
With ActiveChart.Axes(xlValue, xlPrimary)
.HasTitle = True
.AxisTitle.Caption = "=" & rCell.Worksheet.Name & "!" & rCell.Address(ReferenceStyle:=xlR1C1)
End With
End Sub
Sub xAxisTitle()
Dim rCell As Range
Set rCell = Range("J10")
With ActiveChart.Axes(xlCategory, xlCategory)
.HasTitle = True
.AxisTitle.Caption = "=" & rCell.Worksheet.Name & "!" & rCell.Address(ReferenceStyle:=xlR1C1)
End With
End Sub
Sub add_Gridlines()
Dim cht As Chart
' change chart name here
Set cht = Sheets("Chart").ChartObjects("Chart1").Chart
With cht.Axes(xlCategory, xlPrimary)
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(204, 204, 204)
.MajorGridlines.Border.LineStyle = xlContinuous
.MajorGridlines.Border.Weight = xlThin
.HasMinorGridlines = False
End With
With cht.Axes(xlValue, xlPrimary)
.HasMajorGridlines = True
.HasMinorGridlines = False
.MajorGridlines.Border.Color = RGB(204, 204, 204)
.MinorGridlines.Border.LineStyle = xlContinuous
.MinorGridlines.Border.Weight = xlThin
'Remove ChartArea border
cht.ChartArea.Border.LineStyle = xlNone
End With
End Sub
Sub formatAxis()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.Axes(xlValue).AxisTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
ActiveChart.Axes(xlCategory).AxisTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
ActiveChart.ChartTitle.Select
With Selection.Format.TextFrame2.TextRange.Font.Fill
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 0)
.Transparency = 0
.Solid
End With
Selection.Format.TextFrame2.TextRange.Font.UnderlineStyle = _
msoUnderlineSingleLine
End Sub
Sub TitleFont()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.ChartTitle.Select
ActiveChart.ChartTitle.Font.Size = 12
End Sub
Sub ChartSize24()
ActiveSheet.ChartObjects("Chart1").Activate
With ActiveChart.Parent
.Height = 205
.Width = 230
End With
End Sub
Sub changeLegendSeries()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.FullSeriesCollection(1).Name = "=Chart!$J$13"
ActiveChart.FullSeriesCollection(2).Name = "=Chart!$J$14"
ActiveChart.FullSeriesCollection(3).Name = "=Chart!$J$15"
ActiveChart.FullSeriesCollection(4).Name = "=Chart!$J$16"
ActiveChart.FullSeriesCollection(5).Name = "=Chart!$J$17"
ActiveChart.FullSeriesCollection(6).Name = "=Chart!$J$18"
ActiveChart.FullSeriesCollection(7).Name = "=Chart!$J$19"
ActiveChart.FullSeriesCollection(8).Name = "=Chart!$J$20"
End Sub
Sub DeleteChart()
ActiveSheet.ChartObjects("Chart1").Activate
ActiveChart.Parent.Delete
End Sub
Sub Button11_Click()
Call Sheet2.CreateChart
Call Sheet2.ScaleAxes
Call Sheet2.AddChartTitle
Call Sheet2.AddStuffToChart
Call Sheet2.add_Gridlines
Call Sheet2.xAxisTitle
Call Sheet2.yAxisTitle
Call Sheet2.formatAxis
Call Sheet2.ChartSize24
Call Sheet2.TitleFont
Call Sheet2.changeLegendSeries
End Sub
21803