I am running a macro to resize my plot area to make all graphs uniform within a report. However, when resizing the plot area the Chart Data Table resizes as well and the Labels for the rows in the Data Table become text wrapped. This issue is fixed if I manually resize the Plot Area slightly and then the text is fixed and is autofit and no longer text wrapped to take up three or four lines. Any way to fix this? This is my current code.
Sub Color_Loop_Series()
Dim sht As Worksheet
Dim CurrentSheet As Worksheet
Dim cht As ChartObject
Dim ser As Series
For Each sht In ActiveWorkbook.Worksheets
For Each cht In sht.ChartObjects
cht.Activate
ActiveChart.ChartType = xlLineMarkers
ActiveChart.Legend.Position = xlLegendPositionBottom
ActiveChart.Legend.Font.Size = 9
ActiveChart.PlotArea.Select
Selection.Width = 380
Selection.Left = 11
Selection.Top = 3
Selection.Height = 250
ActiveChart.Axes(xlValue).AxisTitle.Position = xlAxisPositionLeft
ActiveChart.DataTable.Font.Size = 5.5
Next cht
Next sht
End Sub
I was able to duplicate your problem using Excel 2010 by recording a macro while moving the plot area. When running the recorded macro the data table legend resized and text wrapped. I was not able to find any direct handle for the data table legend but did find that both .Left and .InsideLeft affect word wrapping.
Here is your code, modified a little to remove all Active statements.
Sub Color_Loop_Series()
Dim sht As Worksheet
Dim CurrentSheet As Worksheet
Dim cht As ChartObject
Dim ser As Series
For Each sht In ActiveWorkbook.Worksheets
For Each cht In sht.ChartObjects
With cht.Chart
.ChartType = xlLineMarkers
.Legend.Position = xlLegendPositionBottom
.Legend.Font.Size = 9
.DataTable.Font.Size = 5.5
.Axes(xlValue).AxisTitle.Position = xlAxisPositionLeft
End With
With cht.Chart.PlotArea
.Width = 380
.Height = 250
.Left = 11
.Top = 3
.InsideLeft = 80 '<- Adjust this value
End With
Next cht
Next sht
End Sub
Results when using .InsideLeft
Results when not using .InsideLeft
Related
I created an Excel 2016 VBA scatter chart (separate worksheet w/o legends) and labeled the points with VBA. Source labels are A1:A3 (Events (35-chars) / Date / Y-points) and Data is A2:C17. My labels (orientation -90) overwrite the Y-points and bunch up because the Y-axis plot area takes up the entire worksheet. I have tried different Y-axis values but the plot area expands to fill the worksheet. I have also tried to change the plot size with VBA. I need the labels above the actual chart plot.
The secondary issue is I cannot plot a Date & Time, just a Date and have a problem creating Error Bars with xlMinusValues 100% and SeriesCollection(1).
I have been doing this in separate modules for ease of use, but will be combining or using a Call. I find I cannot build a chart with more than 16 data records, so I will be working on a looping routine if more records are present.
TIMELINE MODULE
Option Explicit
Sub Timeline()
Dim sCount As Long
Dim labelrotation As Long
Dim TimelineChart As Chart
Dim LastCell As Long
Dim rng As Range
Dim rngAddr As String
Dim ChartRange As String
With ActiveSheet
Range("C1").End(xlDown).Activate
Set rng = ActiveCell
rngAddr = rng.Address(0, 0)
End With
Let ChartRange = "B2:" & rngAddr
Set TimelineChart = Charts.Add
TimelineChart.Name = "TimelineChart"
With TimelineChart
.SetSourceData Sheets("TimelineData").Range(ChartRange)
.ChartType = xlXYScatter
.Legend.LegendEntries(1).Delete
TimelineChart.HasAxis(xlSecondary) = False
End With
End Sub
LABEL MODULE
Option Explicit
Sub Labels()
Dim r As Range
Dim Events As Range
Dim EventCounter As Integer
Dim s As Series
Sheets("TimelineData").Select
Set Events = Range("A2", Range("A1").End(xlDown))
Set s = Chart1.SeriesCollection(1)
s.HasDataLabels = True
For Each r In Events
EventCounter = EventCounter + 1
s.Points(EventCounter).DataLabel.Text = r.Value
s.Points(EventCounter).DataLabel.Position = xlLabelPositionAbove
s.Points(EventCounter).DataLabel.Orientation = 45
Next r
End Sub
I am going to withdraw the question. The scatter plot was on a chart sheet versus in the same worksheet as the table from which data is used. Lots of hours spent with a conclusion I should use a bar chart, same worksheet, modified.
Thanks to all that looked and considered a response.
how to set chart location i have below code
Dim rng As Range
Dim cht As Object
'Your data range for the chart
Set rng = ActiveSheet.Range("C10:Q12")
'Create a chart
Set cht = ActiveSheet.Shapes.AddChart2
'Give chart some data
cht.Chart.SetSourceData Source:=rng
'Determine the chart type
cht.Chart.ChartType = xlLineMarkers
'Change chart's title
cht.Chart.ChartTitle.Text = "Budget vs Actual (Income)"
You mean, location of chart on the worksheet?
First, you're better off using this to declarecht:
Dim cht As ChartObject
Then to locate cht, you can use (for example):
cht.Left = 150
cht.Top = 100
or tie cht to a cell's location:
cht.Left = ActiveSheet.Range("D4").Left
cht.Top = ActiveSheet.Range("D4").Top
I am trying to create a chart and reposition it afterwards to the correct location on my PowerPoint sheet. But receive a runtime error. The relevant bits of code are:
(My chart data is not in the code)
Dim myChart As chart
Dim gChartData As ChartData
Dim gWorkBook As Excel.Workbook
Dim gWorkSheet As Excel.Worksheet
'Create the chart and set a reference to the chart data.
Set myChart = ActivePresentation.Slides(2).Shapes.AddChart.chart
Set gChartData = myChart.ChartData
'Set the Workbook and Worksheet references.
Set gWorkBook = gChartData.Workbook
Set gWorkSheet = gWorkBook.Worksheets(1)
With myChart
.ChartType = xlColumnStacked
.ChartStyle = 30
.ApplyLayout 4
.ClearToMatchStyle
End With
With myChart
.PlotArea.Left = 290
.PlotArea.Top = 90
End With
I receive the following error code:
Error: -2147467259 (80004005) during Runtime:
Method Left of object PlotArea failed
Some searching already suggested I may have a macro security problem but in the options all macro actions are currently allowed.
If you need further information please let me know.
Your code is moving the chart within the shape that it's been added to, rather than moving the container shape itself.
You need to move the parent of myChart:
Sub Test()
Dim myChart As Chart
Set myChart = ActivePresentation.Slides(2).Shapes.AddChart.Chart
With myChart
.ChartType = xlColumnStacked
.ChartStyle = 30
.ApplyLayout 4
.ClearToMatchStyle
'Move shape containing chart on PPT.
With .Parent
.Left = 290
.Top = 90
End With
'Move chart plot area within chart (I think).
.PlotArea.Left = 290
.PlotArea.Top = 90
End With
End Sub
I didn't get the error you have, but that could be trying to move the PlotArea outside the shape?
I work heavily with PivotCharts, but have absolutely zero VBA experience. I have excel templates that are uploaded to a database, then can be downloaded as a report with the data from that database. I have a pivotTable/PivotChart combo on one sheet. Sometimes the table has 5 rows of data, and sometimes is has 1200 rows of data, depending on the database, timeframe, etc.
What I'd like to do, is have the chart take up the same number of rows as the table + 3 in height, and always display in D3:J3 for width and starting position. This aligns the data with the charts.
I have found a similar ? from last year here: Resize pivot chart when selecting different less/more values
It has not gotten me any results (or I'm doing something wrong).
Relevant info: table/chart is on Sheet4 ("Summary"), and under PivotTable Options, it is called "IdleSummary".
I appreciate any help that can be given, thanks!
One way to do it, is to use a range object to size your chart like so:
Sub test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Summary")
Dim vPiv As PivotTable
Dim vRowCount As Long
Dim graphSizer As Range
Dim theChart As ChartObject
Set vPiv = ws.PivotTables("IdleSummary")
vRowCount = ws.Range(vPiv.TableRange2.Address).Rows.Count + 3
Set graphSizer = ws.Range("D3:J" & vRowCount)
Set theChart = ws.ChartObjects.Add(Left:=graphSizer.Left, Top:=graphSizer.Top, Width:=graphSizer.Width, Height:=graphSizer.Height)
With theChart.Chart
.SetSourceData vPiv.TableRange2
.ChartType = xlArea 'replace with desired chartType
End With
End Sub
EDIT, to answer comments:
Modifying the above code, and using the worksheet PivotTableUpdate event you could do like so:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
If Target.Name = "IdleSummary" Then
Call Resize
End If
End Sub
Sub Resize()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Summary")
Dim vPiv As PivotTable
Dim vRowCount As Long
Dim graphSizer As Range
Dim theChart As ChartObject
Dim charObj As ChartObject
Set vPiv = ws.PivotTables("IdleSummary")
vRowCount = ws.Range(vPiv.TableRange2.Address).Rows.Count + 3
Set graphSizer = ws.Range("D3:J" & vRowCount)
Set theChart = ws.ChartObjects(1)
With theChart.Chart.Parent
.Left = graphSizer.Left
.Top = graphSizer.Top
.Width = graphSizer.Width
.Height = graphSizer.Height
End With
End Sub
This is assuming you have just one chart, else you can replace the index (1) with the chart name, e.g. ("Chart 1"). If you interested in reading about events you can find an introduction here: http://www.cpearson.com/excel/Events.aspx
I have this code but when the VBA copies and pastes the charts on the Excelsheet, the Charts overlap.
Is there a way to arrange them in 1 column without overlapping?
Thank you!
Sub Test1()
Dim cht As Excel.ChartObject
Worksheets("ChartObjects").ChartObjects.Delete
For Each Sheet In ActiveWorkbook.Worksheets
If Sheet.Name <> "ChartObjects" Then
Sheet.Select
For Each cht In Sheet.ChartObjects
cht.Select
cht.Copy
Sheets("ChartObjects").Select
Range("C5").Select
ActiveSheet.Paste
Next
End If
Next Sheet
End Sub
You can use the .Top and .Left properties of the cell, and the .Top and .Height properties of each ChartObject to align each successive chart with the previous chart's bottom:
Sub foo()
Dim cht As ChartObject
Dim newCht As ChartObject
Dim sht As Worksheet
Dim chtSht As Worksheet
Dim top As Double
Dim left As Double
'Define the destination worksheet
Set chtSht = ActiveWorkbook.Worksheets("ChartObjects")
'Define the starting parameter for the charts
With chtSht.Range("C5")
top = .top
left = .left
End With
'Iterate the sheets in the workbook
For Each sht In ActiveWorkbook.Worksheets
'Ignore the chtSheet
If Not sht.Name = chtSht.Name Then
'Iterate the charts in each worksheet
For Each cht In sht.ChartObjects
'Copy the chart
cht.Copy
'Paste it in to the destination sheet
chtSht.Paste
'Get a handle on the chart we just pasted
Set newCht = chtSht.ChartObjects(chtSht.ChartObjects.Count)
'Assign the top location of this chart
newCht.top = top
newCht.left = left
'Add with the height of this chart to determine the "top" for the next chart
top = newCht.top + newCht.Height
Next
End If
Next
End Sub