I want to adjust the x and y axis to use value from a specific range from the same sheet where the chart is placed.
And also, each column to be a different color (with a legend present on the chart)
Here is my code so far:
Dim cht As ChartObject
Set chtChart = Worksheets("Sheet1").ChartObjects.Add(Left:=75, Width:=300, Top:=75, Height:=300).Chart
With chtChart
.ChartType = xlColumnStacked
End With
EDIT: I am fine with using just chart, it doesn't have to be ChartObject. But when I use just "Chart", another sheet gets created (besides placing the chart on the desired sheet) and I want to avoid that.
Here is some code that could help you :
Sub Graph()
Dim Gr As Chart
Set Gr = ActiveWorkbook.Worksheets("Sheet1").ChartObjects.Add(Left:=75, Width:=300, Top:=75, Height:=300).Chart
With Gr
'Définition des données sources du graphique
.SetSourceData Source:=Range(Sheets(Src_Name).Cells(2, 1), Sheets(Src_Name).Cells(20, 5)), PlotBy:=xlRows
'Type de graphique
.ChartType = xlColumnStacked
'Place
.Location Where:=xlLocationAsNewSheet, Name:=NewSheetName
'Titre
.HasTitle = True
.ChartTitle.Characters.Text = "Chart Title"
'Data Series 1
.SeriesCollection.NewSeries
.SeriesCollection(1).Values = Range(Sheets(Src_Name).Cells(2, 2), Sheets(Src_Name).Cells(20, 5))
.SeriesCollection(1).XValues = Range(Sheets(Src_Name).Cells(2, 1), Sheets(Src_Name).Cells(20, 1))
.SeriesCollection(1).AxisGroup = 1
.SeriesCollection(1).Name = "MTTF"
'Data Series 2
.SeriesCollection.NewSeries
.SeriesCollection(2).Values = Range(Sheets(Src_Name).Cells(2, 2), Sheets(Src_Name).Cells(20, 5))
.SeriesCollection(2).XValues = Range(Sheets(Src_Name).Cells(2, 1), Sheets(Src_Name).Cells(20, 1))
.SeriesCollection(2).Name = "MTTR"
'Second axis
.SeriesCollection(2).AxisGroup = 2
'.SeriesCollection(3).Delete
'.SeriesCollection(i).Format.Line.Weight = 1
'.SeriesCollection(i).Format.Line.ForeColor.RGB = RGB(int1 as integer, int1 as integer, int3 as integer) ' pour une ligne
'.SeriesCollection(i).Format.Fill.ForeColor.RGB = RGB(int1 as integer, int1 as integer, int3 as integer) ' pour une area
'Axis parameters
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Age"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Text = "Hours"
.PlotArea.Interior.ColorIndex = 2
.Axes(xlValue).MajorGridlines.Border.LineStyle = xlDot
.ChartArea.Font.Size = 14
.Deselect
End With
'Legend positioning
With ActiveChart.Legend
.Left = 350
.Top = 75
End With
'Drawing area positiong
With ActiveChart.PlotArea
.Width = 550
.Height = 350
End With
'Clean memory
Set Gr = Nothing
End Sub
You'll just have to adjust your data selection and names and it should be a good start
Related
I have a worksheet with 300 columns and would like to create one scatter plot for each column, bringing data from two other sheets that are in the same worksheet.
The problem is that I´m not familiar with VBA, and some error codes don't help at all.
Private Sub Create_Charts()
Dim sh As Worksheet
Dim chrt As Chart
For i = 1 To 300
Set sh = ActiveWorkbook.Worksheets("Graphs")
Set chrt = sh.Shapes.AddChart.Chart
With chrt
'Data
.ChartType = xlXYScatter
.SeriesCollection.NewSeries
.SeriesCollection(1).Name = "=""Scatter Chart"""
'With the following parameters it works:
'.SeriesCollection(1).XValues = "=OP!$c$4:$c$1588"
'.SeriesCollection(1).Values = "=PV!$c$4:$c$1588"
'But I need something like this:
.SeriesCollection(1).XValues = CStr(Worksheets("PV").Range(Cells(i, 4), Cells(i, 1588)))
.SeriesCollection(1).Values = CStr(Worksheets("OV").Range(Cells(i, 4), Cells(i, 1588)))
'Location
.ChartArea.Left = 380 * i - 380
.ChartArea.Top = 100
.ChartArea.Height = 360
.ChartArea.Width = 360
'Formatting
.Axes(xlCategory).HasMajorGridlines = True
.Axes(xlValue).HasMajorGridlines = True
.HasAxis(xlCategory, xlPrimary) = False
.HasAxis(xlValue, xlPrimary) = False
.HasLegend = False
End With
Next i
End Sub
This line references a column:
.SeriesCollection(1).XValues = "=OP!$c$4:$c$1588"
This references a row, row i from column 4 to column 1588:
.SeriesCollection(1).XValues = CStr(Worksheets("PV").Range(Cells(i, 4), Cells(i, 1588)))
But you also need to reference not only Range but Cells. And if you pass in a string address, you need the leading "="; it's easier to pass in a range. So try this:
Dim wsPV As Worksheet, wsOV As Worksheet
Dim rngX As Range, rngY As Range
Set wsPV = ActiveWorkbook.Worksheets("PV")
Set wsOV = ActiveWorkbook.Worksheets("OV")
Set rngX = wsPV.Range(wsPV.Cells(4, i), wsPV.Cells(1588, i)
Set rngY = wsOV.Range(wsOV.Cells(4, i), wsOV.Cells(1588, i)
chrt.SeriesCollection(1).XValues = rngX
chrt.SeriesCollection(1).Values = rngY
So I am trying to format a XY scatter chart in Excel using VBA and I would like to have lines connecting the markers, but for both the markers and the marker lines I would like for them to be invisible.
For some reason both the marker line and the line that connects the markers both use the same code to change their visibility property.
chart.SeriesCollection(1).Format.Line.Visible = msoFalse
I can change the colours independently using the MarkerBackGroundColor property, but I can't seem to figure out how to make one visible without making the other visible as well.
Any help on this would be very much appreciated.
You can use
FullSeriesCollection(1).Border.LineStyle = xlNone
or
FullSeriesCollection(1).Border.LineStyle = xlSolid
to format the line only.
The code seems to set point. Bellow code is sample of setting points.
Sub ScatterChart_setPoint()
Dim Ws As Worksheet
Dim DB As Range, myCell As Range
Dim Ch As Chart
Dim i As Integer, n As Long, r As Integer, g As Integer, b As Integer
Dim vX(), vY(), vLable(), vMarker
Dim pnt As Point
Dim Shp As Shape
Dim h As Single, w As Single, l As Single, t As Single, fs As Single
Application.DisplayAlerts = False
Set Ws = ActiveSheet 'Sheets("Current Account")
Ws.Activate
Ws.Range("a65536").Select
vMarker = Array(xlMarkerStyleCircle, xlMarkerStyleDash, xlMarkerStyleDiamond, xlMarkerStyleDot, _
xlMarkerStylePlus, xlMarkerStyleSquare, xlMarkerStyleStar, _
xlMarkerStyleTriangle, xlMarkerStyleX)
Set DB = Ws.Range("h3", Ws.Range("h3").End(xlDown)) '<~~ range of data
For Each myCell In DB
If myCell = 0 Or myCell.Offset(, 10) = "" Then
Else
n = n + 1
ReDim Preserve vX(1 To n)
ReDim Preserve vY(1 To n)
ReDim Preserve vLable(1 To n)
vX(n) = myCell
vY(n) = myCell.Offset(, 10)
vLable(n) = myCell.Offset(, -7)
End If
Next myCell
Charts.Add
With ActiveChart
.HasTitle = True
.ChartType = xlXYScatter
.Legend.Position = xlLegendPositionRight
With .ChartTitle
.Characters.Text = Ws.Range("a1").Value
.Characters.Font.Size = 12
End With
.SeriesCollection.NewSeries
With .SeriesCollection(1)
.Name = "OECD"
.XValues = vX
.Values = vY
.Trendlines.Add
With .Trendlines(1)
.DisplayRSquared = True
.DisplayEquation = True
End With
End With
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = Ws.Range("r2")
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = Ws.Range("h2")
For i = 1 To n
Set pnt = .SeriesCollection(1).Points(i)
With pnt
.ApplyDataLabels
.DataLabel.Text = vLable(i)
.DataLabel.ShowValue = False
.DataLabel.ShowCategoryName = True
.MarkerStyle = vMarker(WorksheetFunction.RandBetween(0, 8))
With WorksheetFunction
r = .RandBetween(0, 240)
g = .RandBetween(0, 240)
b = .RandBetween(0, 240)
End With
.MarkerForegroundColor = RGB(r, g, b)
.MarkerBackgroundColor = RGB(r, g, b)
End With
.ApplyDataLabels
Next i
Application.DisplayAlerts = True
End Sub
I wrote the following code to add a chart and position it on a worksheet with data on it:
Dim sh As Worksheet
Dim chrteit As Chart
lastrows = Range("A2").End(xlDown).Row
Set sh = ActiveWorkbook.Worksheets("TraceTable")
Set chrteit = sh.Shapes.AddChart.Chart
With chrteit
.ChartType = xlXYScatter
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = sh.Range(Cells(2, 6), Cells(lastrows, 6))
.SeriesCollection(1).Values = sh.Range(Cells(2, 7), Cells(lastrows, 7))
.HasTitle = True
.ChartTitle.Text = "EIT"
.Parent.Height = Range("N2:N14").Height
.Parent.Width = Range("N2:T2").Width
.Parent.top = Range("N2").top
.Parent.Left = Range("N2").Left
End With
The problem is, later in my module I have a macro that will an entire row between two data points if the two data points are different, and it is as follows:
Private Sub Dividers()
Dim DividerRange As Range, lastrow As Long, k As Integer, counter As Integer
lastrow = Range("C2").End(xlDown).Row
Set DividerRange = Range(Cells(2, 3), Cells(lastrow, 3))
counter = 0
For k = 2 To DividerRange.Count
If DividerRange(k + counter).Value <> DividerRange(k + counter - 1).Value Then
DividerRange(k + counter).EntireRow.Insert
counter = counter + 1
Else
End If
Next k
End Sub
By adding the entire row, it changes the height of my graph and it's position. I want it to be a fixed position, how can I do this? I would PREFER not to change the second code, but rather the first but let me know any solutions you guys have, Thanks!
Add this line to the first procedure:
chrteit.Placement = xlFreeFloating
This is the same as right-click, format chart area, properties: Don't move or size with cells.
|
Or you could place that method inside the With block, thusly:
With chrteit
.ChartType = xlXYScatter
.SeriesCollection.NewSeries
.SeriesCollection(1).XValues = sh.Range(Cells(2, 6), Cells(lastrows, 6))
.SeriesCollection(1).Values = sh.Range(Cells(2, 7), Cells(lastrows, 7))
.HasTitle = True
.ChartTitle.Text = "EIT"
.Parent.Height = Range("N2:N14").Height
.Parent.Width = Range("N2:T2").Width
.Parent.top = Range("N2").top
.Parent.Left = Range("N2").Left
.Placement = xlFreeFloating
End With
I am programming an excel application that takes info from a Tables Sheet ( that it is also programmed and the length and position of each table can change) and generate a graphic for each table in other sheet, called Estimation Sheet, when a button is press.
I managed to do this task for the first graphich (corresponding to first table) but when I try to use the same method for the second...it doesn't work. This is the method used to draw the first graphic:
Public Sub generateGraphicsC(RowResistiveC As Integer)
Dim FirstRow As Integer, FirstColumn As Integer, LastRow As Integer, LastColumn As Integer, GraphLocation As Integer
Dim XelementsC As Integer, Yelements As Integer
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim i As Integer
Dim WSD As Worksheet
Set WSD = Worksheets(2) 'Data source
Dim CSD As Worksheet
Set CSD = Worksheets(3) 'ChartOutput
'Dim chrt As ChartObject
'Dim cw As Long
'Dim rh As Long
' get the current charts so proper overwriting can happen Dim chtObjs As ChartObjects
Set chtObjs = CSD.ChartObjects
WSD.AutoFilterMode = False ' Turn off autofilter mode
'Dim finalRow As Long ' Find the last row with data
'finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
FirstRow = RowResistiveC
FirstColumn = 5
XelementsC = countXelementsC(FirstRow - 1, FirstColumn) 'Count the x Elements (amperes)
Yelements = countYelements(FirstRow) 'Count the y Elements (Combinations)
LastRow = FirstRow + Yelements - 1 'The last row and column I will read
LastColumn = FirstColumn + XelementsC - 1
'---------------------DRAW THE GRAPHIC----------------------------------------------'
' Delete any previous existing chart
'Dim chtObj As ChartObject
' define the x axis values
WSD.Activate
Set rngChtXVal = WSD.Range(Cells(FirstRow - 1, FirstColumn), Cells(FirstRow - 1, LastColumn))
' add the chart
Charts.Add
With ActiveChart
' make a XY chart
.ChartType = xlXYScatterLines
' remove extra series
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
.Location Where:=xlLocationAsObject, Name:="Estimation Sheets"
End With
'-----------------------------------------------------------------------------
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Factor C"
'To Interpolate between the ungiven values
.DisplayBlanksAs = xlInterpolated
'TITLE STYLE
.ChartTitle.AutoScaleFont = False
With .ChartTitle.Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
'AXIS STYLE-----------------------------------------------------------------------
.Axes(xlCategory).TickLabels.AutoScaleFont = False
With .Axes(xlCategory).TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
With Selection.Border
.ColorIndex = 15
.LineStyle = xlContinuous
End With
End With
.Axes(xlValue).TickLabels.AutoScaleFont = False
With .Axes(xlValue).TickLabels.Font
.Name = "Calibri"
.FontStyle = "Regular"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
End With
'-----------------------------------------------------------------------------
' HEIGHT; WIDTH AND POSITION
GraphLocation = CSD.Cells(Rows.Count, 2).End(xlUp).Row + 3
Dim RngToCover As Range
Set RngToCover = ActiveSheet.Range(Cells(GraphLocation, 2), Cells(GraphLocation + 20, 11))
With ActiveChart.Parent
.Height = RngToCover.Height ' resize
.Width = RngToCover.Width ' resize
.Top = RngToCover.Top ' reposition
.Left = RngToCover.Left ' reposition
End With
' for each row in the sheet
For i = FirstRow To LastRow
Dim chartName As String
' define chart data range for the row (record)
Set rngChtData = WSD.Range(WSD.Cells(i, FirstColumn), WSD.Cells(i, LastColumn))
'To get the serie name that I´m going to add to the graph
Dim serieName As String
Dim varItemName As Variant
WSD.Activate
varItemName = WSD.Range(Cells(i, 1), Cells(i, 4))
serieName = CStr(varItemName(1, 1) + " " + varItemName(1, 2) + " " + varItemName(1, 3) + " " + varItemName(1, 4))
' add series from selected range, column by column
CSD.ChartObjects.Select
With ActiveChart
With .SeriesCollection.NewSeries
.Values = rngChtData
.XValues = rngChtXVal
.Name = serieName
End With
End With
Next i
'We let as last view the page with all the info
CSD.Select
End Sub
I am calling this Sub from other one. The next step will be calling a similar method (exactly the same but other starting point to get the data and some different format properties)for other kind of table and graphic:
Public Sub printGraphics()
Modul4.ClearGraphs
Modul4.generateGraphicsC (RowResistiveC)
Modul4.generateGraphicsT (RowResistiveT)
End Sub
And so on. CountXelements and Yelements counts the number of elements from the Tables Sheet and RowResistiveC, for example, keeps the position of the table.
GenerateGraphicsC works but generateGraphicsT (exactly the same) crush in the line:
With .SeriesCollection.NewSeries
Whit error 91 ( I have a german version of excel at work but it's something like variable object or bloque object not given).
As I suspected the error came from :
CSD.ChartObjects.Select
That works in my solution for the first graph since I'm selecting the single graphic on the sheet, but when I add more it doesn´t.
I just changed that line for:
CSD.ChartObjects(1).Activate
and so on. It works perfectly. I also had to make some adjusments to avoid all the graphs being plotted over the previous one, but it works nice.
I used Excel VBA to create a chart and I want to adjust the line color and x-axis interval.
Below is the code:
Sub add_cpu_chart(server_hostname, site)
On Error Resume Next
Dim rpt_site As String
rpt_site = site
Set tbl = ThisWorkbook.Sheets(server_hostname).ListObjects(1)
strTableName = tbl.Name
strTableRange = tbl.Range.Address
Dim m_s_name, m_e_name As Date
m_s_name = CDate(fromDateStr)
m_e_name = CDate(toDateStr)
'Create new embedded chart
Set shp = ThisWorkbook.Sheets(server_hostname).Shapes.AddChart
'Position Shape over range
shp.Top = 100
shp.Left = 200
With shp
With .Chart
'Specify source data and orientation
'.SetSourceData Source:=ActiveSheets.Range(Table1 & "[#All]"), _
'PlotBy:=xlRows
.SetSourceData Source:=ThisWorkbook.Sheets(server_hostname).Range(strTableName & "[#All]")
.ChartType = xlLineMarkers
.SetElement (msoElementChartTitleAboveChart)
.HasTitle = True
.ChartTitle.Text = "CPU Utilization of " & server_hostname & " in " & _
rpt_site & " (" & Format(m_s_name, "dd-Mmm") & " to " & Format(m_e_name, "dd-Mmm yyyy") & ")"
.ChartTitle.Font.Size = 14
'.ChartArea.Font.Size = 14
.Legend.Delete
.SetElement (msoElementPrimaryValueAxisTitleRotated)
.Axes(xlValue, xlPrimary).AxisTitle.Text = "CPU Utlization (%)"
.Axes(xlValue, xlPrimary).AxisTitle.Font.Size = 10
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MinorUnit = 2
.Axes(xlValue).MaximumScale = 100
.Axes(xlValue).MajorUnit = 20
.Axes(xlValue).TickLabels.NumberFormat = "General"
.SetElement (msoElementPrimaryCategoryAxisTitleAdjacentToAxis)
.Axes(xlCategory, xlPrimary).AxisTitle.Text = "Date of the Month"
.Axes(xlCategory, xlPrimary).AxisTitle.Font.Size = 10
'.Axes(xlCategory).MajorUnit = 1
.Axes(xlCategory).TickLabels.NumberFormat = "d"
With .PlotArea.Format.Fill
.Visible = msoTrue
.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = -0.150000006
.Transparency = 0
.Solid
End With
End With
End With
End Sub
I want to change the line color to red - as in excel 2003 - as well as change the data in interval separated by 2 days. Currently, the data is in the form 1,2,3,4... I want to display the data in the form 1,3 ,5....
In a line chart, the X axis' minimumscale, maximum scale, majorunit, and minorunit are meaningless. The X values are merely categories which have no interpreted numerical values even if the labels show numerals.
You should probably change to an XY chart, which will allow full control over the axis scale using minimumscale, maximum scale, majorunit, and minorunit. Of course, an XY chart allows the same formatting of series markers and lines as in a line chart, but the confusing terminology will live on forever.
If for some reason you decide to stick with a line chart, you can use
ActiveChart.Axes(xlCategory).TickLabelSpacing = 2