Creating a chart in powerpoint using VBA only without embedded excel data - vba

I am working on a personal powerpoint project and I thought it would be cool to use activex in the powerpoint to make the slides a bit more interactive. I have some activex boxes where you can set a population and an annual growth rate and the final step would be for me to plot the 5 year projection data i am getting on a line graph. I have tried it using excel based VBA but most solutions seem to require pulling data from a sheet so won't work in powerpoint.
I have also tried the following code to build a chart skipping the need for a worksheet but to no avail as I get a runtime error 424: Object required error:
Sub AddChart()
Dim cht As Chart
Dim ser As Series
Set cht = Charts.Add
cht.ChartType = xlColumnClustered
Set ser = cht.SeriesCollection.NewSeries
ser.XValues = Array(1, 3, 5, 7, 9)
ser.Values = Array(2.4, 3.2, 5.7, 12.67)
End Sub
Any solutions in mind or am I flogging a dead horse here?
Thanks!

Powerpoint doesn't have Charts.Add, but Shapes.AddChart2 or .AddChart
Something like this should get you going:
Sub AddChart()
Dim cht As Chart
Dim ser As Series
Set cht = ActivePresentation.Slides(1).Shapes.AddChart(-1, xlColumnClustered).Chart
Set ser = cht.SeriesCollection.NewSeries
ser.XValues = Array(1, 3, 5, 7, 9)
ser.Values = Array(2.4, 3.2, 5.7, 12.67)
End Sub

I know this is an old thread but in case someone stumbles on it like I did - you can paste an empty chart on a Master Layout and then copy it to any slide you need it on, that way Excel never launches to 'create' the chart object, although it is still 'embedded'.
If you create a special layout for it, just be sure to include a Title or some other placeholder because slides with no placeholders get helpfully removed/left behind by PowerPoint during certain operations - such as copying a slide into a new presentation and selecting 'Keep Source Formatting'.

Related

SetDataSource of Excel Chart from Access VBA

I haven't been able to find any workable solution for this in a couple hours of searching, so here I go.
I am exporting some data from access to excel via vba, formatting the excel and moving worksheets around, and then generating a chart. When I was testing it all in an excel macro I was able to use the SetDataSource method to adjust the range, but when I moved over to Access it didn't like this method, and will throw a run-time error of 438, "Object doesn't support this property or method". Simplified code below.
Dim xl as Object, wb as Object
Set xl = CreateObject("Excel.Application")
With xl
.Visible = False
.displayalerts = False
Set wb = .workbooks.Open(wbookpath)
'formatting code that all works fine
.Charts.Add
'add was called from sheet 11, popped up before 11 and am moving to end
.Sheets(11).move after:=.Sheets(12)
With Charts(1)
.SetSourceData .Range("Master!$A$1:$G$11")
'other chart formatting code that all works fine
End With
.activeworkbook.Close (True)
.Quit
End With
I have also tried changing the source, e.g.
.SetSourceData .Sheets("Master").Range("$A$1:$G$11")
changing where I call it from, e.g.
.Charts.Add
wb.Charts(1).SetSourceData .Range("Master!$A$1:$G$11")
With .Charts(1)
'rest of code
but it doesn't affect the error being thrown.
How can I get Access to adjust the source of my chart? If I can get this working then I would be able to go forward with making a slew of other charts as well.
This syntax worked for me:
With wb.Charts(1)
.SetSourceData Source:=Sheets("Master").Range("$A$1:$G$11")
'other chart formatting code that all works fine
End With
Reference https://learn.microsoft.com/en-us/office/vba/api/excel.chart.setsourcedata

VBA Word: Change Data of charts

I want to change the data of a chart in a Word Document, but I can't find the right way to address my charts. I tried several techniques, but nothing worked. (I´d love to open a ExcelSheet in which I can just change the Data)
So to put it all together: I want to change the data (not the source), of a MS Word chart, which looks like that:
Edit(13.8.):
After request, I try to give you some "reference Code" to work with.
Sub ChangeChart()
Dim aktDocument As Document
Dim chrt As Chart
Dim SourceSheet As Excel.Worksheet
Set aktDocument = ActiveDocument
Set SourceSheet = aktDocument.Shapes(1).Chart.OpenSourceData 'I know it´s not that easy
SourceSheet.Range("B5") = newStuff
aktDocument.Shapes(1).Chart.SetSourceData = SourceSheet
End Sub
I know this may sounds utopic and ridiculous, but I just don´t know, how to address the chart in the right way, or to even work with it properly.
Edit(15.08):
Even after recreating the old charts, the following code is not able to find a shape which has a chart. And therefore it stops when the index is out of range.
Sub Test()
i = 0
Do While i < 100
i = i + 1
If ActiveDocument.Shapes(i).HasChart Then
MsgBox "found one!"
End If
Loop
End Sub
Solution(30.08.):
The answer from #Cindy Meister was the solution to my problem. After further working with it, I came to the problem, that the ChartData always opens on the screen, while running the code.
Just for reference this question was my workaround.
All Office applications use the Excel engine to create and manage charts. In Word, charts can be formatted in-line with the text or with text wrap formatting. In the former case, a chart object needs to be addressed via the InlineShapes collection, in the latter via the Shapes collection.
Since your sample code uses Shapes(1) I've used that in the code snippet below. If it's not certain that the first Shape in the document is the chart, but you've assigned the Shape a name, you can use that as the index value (for example Shapes("MyChart"). Or you can loop the Shapes collection and check HasChart.
HasChart returns True if the Shape (or InlineShape) is a Chart. It's then possible to set Shape.Chart to an object variable. The chart's data can be accessed using Chart.ChartData.Activate - if you don't use Activate it's not possible to access the data when the chart's worksheet is stored in the Word document. Only then can Chart.ChartData.Workbook return a workbook object, and through that the worksheet can be accessed using ActiveSheet. From that point on, it's like working with the Excel object model.
Sub ChangeChart()
Dim aktDocument As Document
Dim shp As Word.Shape
Dim chrt As Word.Chart
Dim wb As Excel.Workbook, SourceSheet As Excel.Worksheet
Set aktDocument = ActiveDocument
Set shp = aktDocument.Shapes(1)
If shp.HasChart Then
Set chrt = shp.Chart
chrt.ChartData.Activate
Set wb = chrt.ChartData.Workbook
Set SourceSheet = wb.ActiveSheet
SourceSheet.Range("B5").Value2 = newData
End If
End Sub

Getting a series trend line equation to a shape text box

I'm attempting to get the trend line equation from the first series in my chart to a shape text box placed elsewhere on the worksheet - however, I can only get the textbox to populate correctly when I'm stepping through the code line by line - during run-time it has no effect:
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
ThisWorkbook.Worksheets("MyDataSheet").Shapes(slopetextboxes(k)).TextFrame.Characters.Text = srs.Trendlines(1).DataLabel.Text
srs.Trendlines(1).DisplayEquation = False 'Turn it back off
Exit For
Next srs
k = k + 1 ' for the slope textboxes
Next chtObj
Note that slopetextboxes is an array containing the names of ~6 shape text boxes.
As far as I know there's no way to get the trend line data label without stopping to display it. I've tried storing it in a string first, DoEvents, and turning Application.ScreenUpdating back on, all to no avail. I'm stumped here.
EDIT: It appears that by placing DoEvents after .DisplayEquation = True I'm able to have some of my shapes populate correctly, but not all. Still appears to be some kind of run-time issue.
BOUNTY EDIT: I've moved ahead to grab the slopes with a formula ran into the data itself, but I still don't understand why I can't grab the chart's .DataLabel.Text during run-time. I can grab it when stepping through, not during run-time. It appears to just take the PREVIOUS series slope and place it in the shape (or a cell, it doesn't even matter where the destination is). DoEvents placed in different spots yields different outcomes, so something must be going on.
Updated with better understanding of the bug. This works for me in excel 2016 with multiple changes to the source data (and therefore the slope)
I tried myChart.refresh - didnt work. I tried deleting and then re-adding the entire trendline, also didnt work.
This works for everything but the first case. First case needs to be hit twice. Same as for .select
If you try and delete trendline even after assigning its text to textbox, this wont work
Option Explicit
Sub main()
Dim ws As Worksheet
Dim txtbox As OLEObject
Dim chartObject As chartObject
Dim myChart As chart
Dim myChartSeriesCol As SeriesCollection
Dim myChartSeries As Series
Dim myChartTrendLines As Trendlines
Dim myTrendLine As Trendline
Set ws = Sheets("MyDataSheet")
Set txtbox = ws.OLEObjects("TextBox1")
For Each chartObject In ws.ChartObjects
Set myChart = chartObject.chart
Set myChartSeriesCol = myChart.SeriesCollection
Set myChartSeries = myChartSeriesCol(1)
Set myChartTrendLines = myChartSeries.Trendlines
With myChartTrendLines
If .Count = 0 Then
.Add
End If
End With
Set myTrendLine = myChartTrendLines.Item(1)
With myTrendLine
.DisplayEquation = True
txtbox.Object.Text = .DataLabel.Text
End With
Next chartObject
End Sub
Here's my code that seems to definitely work when just pressing F5:
Basically, I store the text in a collection, then iterate through all of the textboxes to add the text to the textboxes. If this wasn't precisely what you were asking for, then I hope this helps in any way.
Sub getEqus()
Dim ws As Worksheet
Dim cht As Chart
Dim srs As Variant
Dim k As Long
Dim i As Long
Dim equs As New Collection
Dim shp As Shape
Dim slopetextboxes As New Collection
Set ws = Excel.Application.ThisWorkbook.Worksheets(1)
'part of the problem seemed to be how you were defining your shape objects
slopetextboxes.Add ws.Shapes.Range("TextBox 4")
slopetextboxes.Add ws.Shapes.Range("TextBox 5")
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
equs.Add srs.Trendlines(1).DataLabel.Text
srs.Trendlines(1).DisplayEquation = False 'Turn it back off
Next srs
Next chtObj
For i = 1 To slopetextboxes.Count
'test output i was trying
ws.Cells(i + 1, 7).Value = equs(i)
slopetextboxes(i).TextFrame.Characters.Text = equs(i)
Next
End Sub
Pictures of what the output looks like when i just press the button
Good luck!
This worked for me - I loop through multiple charts on Sheet1, toggling DisplayEquation and then writing the equation to a textbox/shape on the different worksheet. I used TextFrame2.TextRange but TextFrame worked as well, if you prefer that. I wrote to both a regular text box, as well as a shape, which was probably overkill as the syntax is the same for both.
This gets the trendline equation from the first Series - it sounded like you didn't want to loop through all the Series in the SeriesCollection.
Sub ExtractEquations()
Dim chtObj As ChartObject
Dim slopeTextBoxes() As Variant
Dim slopeShapes() As Variant
Dim i As Integer
slopeTextBoxes = Array("TextBox 1", "TextBox 2", "TextBox 3")
slopeShapes = Array("Rectangle 6", "Rectangle 7", "Rectangle 8")
For Each chtObj In ThisWorkbook.Sheets("Sheet1").ChartObjects
With chtObj.Chart.SeriesCollection(1).Trendlines(1)
.DisplayEquation = True
ThisWorkbook.Sheets("MyDataSheet").Shapes(slopeTextBoxes(i)).TextFrame2.TextRange.Characters.Text = .DataLabel.Text
ThisWorkbook.Sheets("MyDataSheet").Shapes(slopeShapes(i)).TextFrame2.TextRange.Characters.Text = .DataLabel.Text
.DisplayEquation = False
i = i + 1
End With
Next chtObj
End Sub
I've written this off as a bug - The only workaround was discovered by BrakNicku which is to Select the DataLabel before reading its Text property:
srs.Trendlines(1).DataLabel.Select
Not a sufficient solution (since this can cause some issues during run-time), but the only thing that works.
I had a similar issue running the code below and my solution was to run Application.ScreenUpdating = True between setting the trendline and querying the DataLabel. Note that screen updating was already enabled.
'Set trendline to the formal y = Ae^Bx
NewTrendline.Type = xlExponential
'Display the equation on the chart
NewTrendline.DisplayEquation = True
'Add the R^2 value to the chart
NewTrendline.DisplayRSquared = True
'Increse number of decimal places
NewTrendline.DataLabel.NumberFormat = "#,##0.000000000000000"
'Enable screen updating for the change in format to take effect otherwise FittedEquation = ""
Application.ScreenUpdating = True
'Get the text of the displated equation
FittedEquation = NewTrendline.DataLabel.Text
If it works when you step through, but not when it runs then it's an issue with timing and what Excel is doing in between steps. When you step through, it has time to figure things out and update the screen.
FYI, Application.Screenupdating = False doesn't work when stepping
through code. It gets set back to True wherever the code pauses.
When did you give it a chance to actually do the math and calculate the equation? The answer is that, you didn't; hence why you get the previous formula.
If you add a simple Application.Calculate (in the right spot) I think you'll find that it works just fine.
In addition, why should Excel waste time and update text to an object that isn't visible? The answer is, it shouldn't, and doesn't.
In the interest of minimizing the amount of times you want Excel to calculate, I'd suggest creating two loops.
The first one, to go through each chart and display the equations
Then force Excel to calculate the values
Followed by another loop to get the values and hide the equations again.
' Display the labels on all the Charts
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
srs.Trendlines(1).DisplayEquation = True 'Display the labels to get the value
' I take issue with the next line
' Why are you creating a loop, just for the first series?
' I hope this is just left over from a real If condition that wan't included for simplicity
Exit For
Next srs
Next chtObj
Application.ScreenUpdating = True
Application.Calculate
Application.ScreenUpdating = False
' Get the Equation and hide the equations on the chart
For Each chtObj In ActiveSheet.ChartObjects
Set cht = chtObj.Chart
For Each srs In chtObj.Chart.SeriesCollection
ThisWorkbook.Worksheets("MyDataSheet").Shapes(slopetextboxes(k)).TextFrame.Characters.Text = srs.Trendlines(1).DataLabel.Text
srs.Trendlines(1).DisplayEquation = False 'Turn it back off
Exit For
Next srs
k = k + 1 ' for the slope textboxes
Next chtObj
Application.ScreenUpdating = True
Update:
I added a sample file based on your description of the issue. You can select 4 different options in an ActiveX ComboBox which copies values to the Y-Values of a chart. It shows the trend-line equation below, based on the formula & through copying the value from the chart into a Textbox shape.
Maybe 2016 is different, but it works perfectly in 2013. Try it out...
Shape Text Box Example.xlsm

VBA PPT copy/paste chart inconsistent

I'm slowly getting crazy because of this problem. I'm creating a powerpoint presentation from an excel workbook, where data needs to be filled in. I'm creating multiple slides already with no issues and tackled most problems already.
One of the final things for me to do is copy a chart from excel and pasting it in my ppt. This has worked before, but suddenly it just breaks, it doesnt want to paste the chart anymore.
In my main module I call sub ROI with some required data to continue
Call ROI(PPPRes, Slidestart, language, i)
This is in a seperate Module to keep things clean in the main module
Sub ROI(PPPRes, Slidenumber, language, proposal)
Set pp = CreateObject("PowerPoint.Application")
Dim oPPTShape As PowerPoint.Shape
Dim PPSlide As PowerPoint.Slide
Dim ColumnWidthArray As Variant
Dim i As Integer
'Create a slide on Slidenumber location
Set PPSlide = PPPRes.Slides.Add(Slidenumber, ppLayoutTitleOnly)
PPSlide.Select
PPSlide.Shapes("Title 1").TextFrame.TextRange.Text = Range("Titlename in chosen language")
PPSlide.Shapes.AddTable(3, 3).Select
Set oPPTShape = PPSlide.Shapes("Table 4")
'Filling in data in the table from an excel table. Basic stuff working with a few loops to make this happen
'Changing the width of the created table, column by column
ColumnWidthArray = Array(37, 210, 180)
Set oPPTShape = PPSlide.Shapes("Table 4")
On Error Resume Next
With oPPTShape
For i = 1 To 3
.table.columns(i).width = ColumnWidthArray(i - 1)
Next i
.Top = 180
.Left = 520
.height = 200
End With
'Add a rectangle on the slide
PPSlide.Shapes.AddShape Type:=msoShapeRectangle, Left:=404, Top:=400, width:=153, height:=43
'Copy a picture from excel and paste it in the active slide
Sheets("Shapes").Shapes("ROI_img").Copy
PPSlide.Shapes.Paste.Select
pp.ActiveWindow.Selection.ShapeRange.Left = 800
pp.ActiveWindow.Selection.ShapeRange.Top = 20
'Copy chart from excel (with index number that is linked to "proposal") and then paste onto slide
Sheets("Proposals").Shapes("ChartInvProp" & proposal).Copy
PPSlide.Shapes.Paste.Select
Set oPPTShape = PPSlide.Shapes("ChartInvProp" & proposal)
With PPSlide.Shapes("ChartInvProp" & proposal)
.Left = 20
.Top = 120
.width = 480
.height = 320
End With
end sub
So everything in the code is executed, but most of the time the chart from excel is NOT being pasted onto the slide.
However, if I checked what is in the clipboard by breaking the code just after copying the chart from excel. And I then manually paste whatever is in the clipboard into a Word document I will see the chart. --> The action of copying the chart is being executed, but not the pasting part
If I now continue after the break, the chart will be pasted on the powerpoint somehow. But if I do NOT break the code, and let it run its course, the chart will not be pasted.
Somehow it seems to need more time after copy before it can actually paste the chart. I dont really understand what is happening here.
Sometimes it only pastes Chart 1 in the slide, and when it loops for the second/third/etc... chart it doesnt want to paste it anymore.
It really is very random, and I only see a little bit of structure in it not executing...
This was the solution, using a 'DoEvents' between copy and pasting.
This issue only occurred with Charts made in Excel, if I made the charts into pictures it worked without a problem. But copy/pasting a chart from Excel apparently takes more processing time and was slower than the program run speed. So it would skip from time to time.
Sheets("Proposals").Shapes("ChartInvProp" & proposal).Copy
DoEvents
PPSlide.Shapes.Paste.Select
Got the answer from:
Error in script which copies charts from Excel to PowerPoint

Turning the visibility of chart series on/off using excel Macros/vba

I am making a line graph (chart) in Excel with several data series being plotted onto the same chart.
I need to create a macro/VBA solution that can turn the visibilty of these series on/off via the pressing of a button (or tick box etc)
Similar to this picture (manually done through the excel menu system)
I have tried to look through all the member vars/methods on
https://msdn.microsoft.com/EN-US/library/office/ff837379.aspx
but haven't had much luck.
I have tried playing around with bits like
Charts("Chart1").SeriesCollection(1)
and
Worksheets("Graphical Data").ChartObjects(1)
but I can neither get the chart object ( I get a subscript out of range error) nor able to find any method that would allow me to turn on/off the visibility of individual series.
Any Ideas?
Whenever I don't know how to do something like this, I turn on the macro recorder.
I had a chart with four series, and I used the filter function in Excel 2013 to hide and show the second series, while the macro recorder was running.
Here's the relevant code:
ActiveChart.FullSeriesCollection(2).IsFiltered = True
' series 2 is now hidden
ActiveChart.FullSeriesCollection(2).IsFiltered = False
' series 2 is now visible
The series type (line or column) does not matter, this works for any of them.
I believe the property you are looking for is the SeriesCollection.Format.Line.Visible property. I quickly created an Excel workbook and added a simple data set (just 1-10) and added a line graph "Chart 2" to the sheet Sheet1.
This code turned the visibility of the line off:
Option Explicit
Private Sub Test()
Dim cht As Chart
Dim ser As Series
'Retrieve our chart and seriescollection objects'
Set cht = Worksheets("Sheet1").ChartObjects("Chart 2").Chart
Set ser = cht.SeriesCollection(1)
'Set the first series line to be hidden'
With ser.Format.Line
.Visible = msoFalse
End With
End Sub
And likewise, setting the ser.Format.Line.Visible property to msoTrue made the line visible again.
As for retrieving the chart itself I had to first activate it, then set my cht variable to the ActiveChart. To view the name of your chart, select it and look in the name box (near where you would enter the cell value / formula).
Update
When using the method above, the series name remains in the legend box. I couldn't find a visibility property for the SeriesCollection in the legend, however one workaround is to simply re-name the series as an empty string (this will make the series disappear from the legend) and then rename the series when you want to show it.
This code below will toggle the visibility of the line and series name in the legend.
Option Explicit
Private Sub Test()
Dim cht As Chart
Dim ser As Series
'Retrieve our chart and seriescollection objects'
Set cht = Worksheets("Sheet1").ChartObjects("Chart 1").Chart
Set ser = cht.SeriesCollection(1)
'Set the first series line to be hidden'
With ser.Format.Line
If .Visible = msoTrue Then
.Visible = msoFalse
ser.Name = vbNullString
Else
.Visible = msoTrue
ser.Name = "Series 1"
End If
End With
End Sub
And, whenever you use .Format.Line.Visible = msoTrue just remember to set ser.Name back to whatever the name for your series is.
There is a simple way to on & off the visibility of the series: using filter on your source data.
May it help you easily as follows.
You can insert a new Window. Setone of them to source data sheet and the other window to Chart sheet. Then arrange the two windows to see both at the same time. Now if you filter the series you like on the source data sheet simultaneously you will see the series you desired on the other sheet.