Update PowerPoint chart from Excel using VBA - excel

I have a PowerPoint presentation containing several charts. Each of these charts have an embedded PowerPoint Excel file behind the chart. The embedded Excel file source its data from an Excel (Master) file. When I make any changes in the Excel (Master) file these changes are not automatically displayed in the chart. In order to get the change reflected in the chart I need to right click the chart and then choose "Edit data". I found below code which helps me to automatically open all the embedded Excel files in the presentation.
My question is now, if I do not want the macro to open all the embedded Excel files but perhaps only a specific chart (chart 1). If so, how should I then re-write the code so it only open the embedded Excel file for Chart 1?
Update PowerPoint chart using VBA
Sub update2()
Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim myChart As PowerPoint.Chart
Dim Wb As Object
Dim App As Object
Set myPresentation = ActivePresentation
{For Each sld In myPresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Set myChart = shp.Chart
myChart.ChartData.Activate
myChart.Refresh
Set Wb = myChart.ChartData.Workbook
Set App = Wb.Application
Wb.Close (0)
End If
Next
Next
App.Quit
End Sub

Related

Updating Powerpoint Charts linked to Password Protected Excel File

I ve got a password protected excel workbook and a powerpoint presentation which has many charts linked to this workbook. What I am trying to do is updating all charts in the presentation without entring a password. I tried to reach data via ChartData object but couldn't find out how to access workbook with a password written in the code. I had also tried creating an excel object however this time after setting workbook as unprotected I couldn't define the code that refresh links between charts and data.
I appreciate any effort that helps me to solve this problem.
I had found this code from this link and I inserted myChart.ChartData.Workbook.UnProtect Password:="1234", writeResPassword:="1234", ReadOnly:=False, Updatelinks:=3. Unfortunately it is still asking for password.
Sub update2()
Dim myPresentation As PowerPoint.Presentation
Dim sld As PowerPoint.Slide
Dim shp As PowerPoint.Shape
Dim myChart As PowerPoint.Chart
Dim Wb As Object
Dim App As Object
Set myPresentation = ActivePresentation
For Each sld In myPresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Set myChart = shp.Chart
myChart.ChartData.Activate
myChart.Refresh
Set Wb = myChart.ChartData.Workbook
Set App = Wb.Application
Wb.Close (0)
End If
Next
Next
App.Quit
End Sub
I think as it gets to the line myChart.ChartData.Activate then password input box is triggered and from that point the rest of the code doesnt work.
I assume that when we reach chart data through powerpoint it runs an explicit app. If so how I can pass the password dialog in that app.

Refresh Embedded Excel Data in Powerpoint Charts

I'm trying to automate the creation of a PowerPoint deck that I create a few times a week. I use a program called Alteryx to update the embedded excel files for all my charts in PowerPoint and that part works great. The problem that I have is that once I open PowerPoint, all the charts look the same as they originally were. It's only when I click edit data, that PowerPoint seems to read the excel changes and updates the chart. I have over 50 charts that I need to update, and clicking edit data on each one is very time consuming.
Is there a macro that can be created that will refresh all charts in my deck?
Thank you in advance for your time!
Update 1
I have tried using the following code from another post, but it results in 50 open workbooks.
Dim pptChart As Chart
Dim pptChartData As ChartData
Dim pptWorkbook As Object
Dim sld As Slide
Dim shp As Shape
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasChart Then
Set pptChart = shp.Chart
Set pptChartData = pptChart.ChartData
pptChartData.Activate
shp.Chart.REFRESH
On Error Resume Next
On Error GoTo 0
End If
Next
Next
Set pptWorkbook = Nothing
Set pptChartData = Nothing
Set pptChart = Nothing
I tried using the following code to open and close all the embedded workbooks, but it results in an error at this part "ActiveWindow.View.GotoSlide s.Slideindex"
Sub refreshchart()
Dim ppApp As PowerPoint.Application, sld As Slide
Dim s As PowerPoint.Shape
Dim gChart As Chart, i As Integer
ppApp.Visible = True
i = 3
Set sld = ActivePresentation.Slides(i)
sld.Select
For Each s In ActivePresentation.Slides(i)
If s.Type = msoEmbeddedOLEObject Then
s.Select 'select the object
s.OLEFormat.Activate 'Activate it (like 2x click))
ActiveWindow.Selection.Unselect 'To let it close
ActiveWindow.View.GotoSlide s.Slideindex 'make current slide active
End If
Next s
End Sub
A macro that opens the workbooks to refresh the charts and automatically closes them would be great. Thank you!

Is there a way to create excel worksheets out of a powerpoint presentation?

I want to create excel worksheets out of a powerpoint presentations where i can keep the format of the powerpoint slides and am able to adjust certain values. Does anyone know a way?
I heard of creating powerpoint slides out of a excel worksheet, though I need to go the other way around as I want to keep the format of the powerpoint slides but need to be able to adjust certain values. Does anyone know a way?
I basically need a Excel worksheet that looks and works like my powerpoint slide.
Here's what I have so far:
Dim PowerPointApp As Object
Dim myPresentation As Object
.
.
.
'Adds a slide to the presentation - is this also possible for worksheets?
Set mySlide = myPresentation.slides.Add(myPresentation.slides.Count + 1, 11) '11 = ppLayoutTitleOnly
' Pastes the copied range out of the excel into the Powerpoint
mySlide.Shapes.PasteSpecial DataType:=2
.
.
.
What I would like to do is to turn these around, I cant find any hints how to. Neither in books nor on the internet.
Here is a rudimentary approach. This code, which is run from within Excel, requires a reference to the powerpoint object library. It creates a new worksheet in Excel, one for each slide, and copies across the slide contents (ie. all the shapes). It positions the shapes per where they are located on the slide. A bit of a concept starter. Cheers.
Option Explicit
' ---> ADD REFERENCE TO MICROSOFT POWERPOINT OBJECT LIBRARY
Public Sub CreateSheetsFromSlides()
Dim vPowerPoint As PowerPoint.Application
Dim vPresentation As PowerPoint.Presentation
Dim vSlide As PowerPoint.Slide
Dim vPowerpointShape As PowerPoint.Shape
Dim vExcelShape
Dim vSheet As Worksheet
' Open the powerpoint presentation
Set vPowerPoint = New PowerPoint.Application
Set vPresentation = vPowerPoint.Presentations.Open("source.pptx")
' Loop through each powerpoint slide
For Each vSlide In vPresentation.Slides
' Create a new worksheet ... one per slide ... and name the worksheet same as the slide
Set vSheet = ThisWorkbook.Sheets.Add(, After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
vSheet.Name = vSlide.Name
MsgBox vSheet.Name
' Loop through each shape on the powerpoint slide and copy to the new worksheet
For Each vPowerpointShape In vSlide.Shapes
vPowerpointShape.Copy
' Create the shape on the worksheet and position it on the sheet at the same top/left as it is on the slide
vSheet.PasteSpecial
Set vExcelShape = vSheet.Shapes(vSheet.Shapes.Count)
vExcelShape.Top = vPowerpointShape.Top
vExcelShape.Left = vPowerpointShape.Left
Next
Next
vPresentation.Close
vPowerPoint.Quit
End Sub

Excel VBA: Excel range to just opened powerpoint

I have already the code to open a specific powerpoint template from a sharepoint. It already works. What I want next is to copy multiple ranges from different sheets to the first slide of the template of the newly opened powerpoint. By the way, my sheets are 4 and each has defined ranges to copy. I would like it to paste on the same slide with different positions.
Currently I only have this code to open the powerpoint template:
Sub SPPPT()
'*************Open template in sharepoint*****************************
Dim FullTemplatePath As String
Set PPApp = New PowerPoint.Application
Dim OperationalKPI As Worksheet
Set OperationalKPI = Sheets("OperationalKPI")
Dim mySlide As Object
Dim myShape As Object
Dim PowerPointApp As Object
Dim myPresentation As Object
FullTemplatePath = "FilePathofPowerpointTemplate/PPT Template.pptx"
'Open the PowerPoint template
PPApp.Presentations.Open (FullTemplatePath)
Dim OperationalKPI As Worksheet
Set OperationalKPI = Sheets("OperationalKPI")
Set rng = OperationalKPI.Range("KPIRange")
End Sub
You can paste the data in various formats. There is a good article here on how to do this, in particular the bit about the different file formats that you can paste the data via.
The method pastes it as a shape. Here is some code I use that is similar to the article:
'//Create and open powerpoint
Dim ppt As PowerPoint.Application
Set ppt = New PowerPoint.Application
'//Set objects and open powerpoint
Dim oPresentation As PowerPoint.Presentation
Dim oTargetSlide As PowerPoint.Slide
Dim oSelect As PowerPoint.ShapeRange
Set oPresentation = ppt.Presentations.Open(sFileName)
'//Copy the data
ThisWorkbook.Sheets("Sheet1").Range("B4:B8").Select
Selection.Copy
'//Paste it into powerpoint
With ppt
Set oTargetSlide = oPresentation.Slides(1)
oTargetSlide.Select
ppt.ActiveWindow.View.GotoSlide oTargetSlide.SlideIndex
Set oSelect =
oTargetSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject)
'//You can now change the .Left, .Top etc of oShape to place it where you want it.
End With
'//Get the save file name....
'... your code here
oPresentation.SaveAs (SaveAsName)
oPresentation.Close
ppt.Quit
I either paste as a ppPasteEnhancedMetafile, ppPastePNG or ppPasteOLEObject.
One key difference with what I am doing is that I am using the PowerPoint 16 object library, rather than just declaring my PowerPoint "as Object".

Copy Excel Table Paste to Specific PPT Slide

Details:
Mac Excel (2016) copying to Mac PPT (2016)
Eventually, I would like to loop through all tables and paste each table on its own individual slide in PPT.
But first I'm trying to simply copy one table from Excel and paste to a Specific PPT File (not a net new presentation).
Sub OpenPPTandCopySelectedTable()
Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
PPT.Visible = True
'Open the specific Template
PPT.Presentations.Open Filename:="/Users/MyNameHere/Downloads/FileName.pptx"
'Make Specific File the Active Presentation
Set PPPres = PPT.ActivePresentation
'Copy the Excel Table
Range("Table1[#All]").Copy
'Select PowerPoint Slide number 2
PPT.Slides(2).Select
'Paste Special
Application.ActiveWindow.View.PasteSpecial DataType:=ppPastePNG
End Sub
What am I doing wrong? Any help would be appreciated.
Try the code below (without using Select and ActivePresentation, which slows down the run-time of your code).
Option Explicit
Sub OpenPPTandCopySelectedTable()
Dim PPT As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim myShape As Object
Set PPT = New PowerPoint.Application
' Open the specific Template and set it (in 1 line)
Set PPPres = PPT.Presentations.Open(Filename:="/Users/MyNameHere/Downloads/FileName.pptx", ReadOnly:=msoFalse)
'Copy the Excel Table
Range("Table1[#All]").Copy
' Paste to PowerPoint and set to MyShape
'Set myShape = PPPres.Slides(2).Shapes.PasteSpecial(ppPastePNG, msoFalse)
' if you want to edit the properties
'With myShape
'.Left =
'.Top =
'End With
' Option 2:
PPPres.Slides(2).Shapes.PasteSpecial (ppPastePNG)
End Sub

Resources