How to dynamically reference PowerPoint slides using VBA - excel

I've written/compiled a macro that opens an Excel file, creates a PowerPoint chart and populates the chart worksheet with data from a worksheet in the Excel file.
I'm trying to alter the macro to loop through the Excel file's worksheets and:
for each worksheet create a PowerPoint slide and chart
populate the PowerPoint chart with data from the worksheet in the Excel file
Presently when I run the macro, the first PowerPoint chart and slide is created correctly. The second slide is created for the Excel file's second worksheet but the PowerPoint chart is not created correctly. The workbook that I'm testing the macro on has two worksheets.
What is the correct way to dynamically reference each new PowerPoint slide? As of now I've been using:
Set pptWorkSheet = pptWorkBook.Worksheets(ActivePresentation.Slides.Count) 'sorta works-changed 8/19
When I go to the debugger it says ActivePresentation.Slides.Count = 2 so I am not sure as to why its not transferring the data to the second PowerPoint chart.
I also may not be referring to the Excel file worksheets correctly here:
pptWorkSheet.Range("a2:b5").Value = xlWB.ActiveSheet.Range("a2:b5").Value
Below is the full macro:
Sub CreateChartAllWKs()
'Create variables
Dim myChart As Chart
Dim pptChartData As ChartData
Dim pptWorkBook As Excel.Workbook
Dim pptWorkSheet As Excel.Worksheet
Dim xlApp As Excel.Application
Dim xlWB As Workbook
Dim xlWS As Worksheet
' Create new excel instance and open relevant workbook
Set xlApp = New Excel.Application
xlApp.Visible = True 'Make Excel visable
Set xlWB = xlApp.Workbooks.Open("C:\filepath\ExcelData.xlsm", True, False) 'Open relevant workbook
'Loop through each worksheet in xlWB and transfer data to new pptWorkBook and
'create new PowerPoint chart
For Each xlWS In ActiveWorkbook.Worksheets
'Add a new slide where we will create the PowerPoint worksheet and chart
ActivePresentation.Slides.Add ActivePresentation.Slides.Count + 1, ppLayoutText
ActiveWindow.View.GotoSlide ActivePresentation.Slides.Count
Set activeSlide = ActivePresentation.Slides(ActivePresentation.Slides.Count)
' Create the chart and set a reference to the chart data.
Set myChart = activeSlide.Shapes.AddChart.Chart 'changed 8/19
Set pptChartData = myChart.ChartData
' Set the PowerPoint Workbook and Worksheet references.
Set pptWorkBook = pptChartData.Workbook
Set pptWorkSheet = pptWorkBook.Worksheets(ActivePresentation.Slides.Count) 'sorta works-changed 8/19
' Add the data to the PowerPoint workbook.
pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("A1:B5")
pptWorkSheet.Range("Table1[[#Headers],[Series 1]]").Value = "Items"
pptWorkSheet.Range("a2:b5").Value = xlWB.ActiveSheet.Range("a2:b5").Value 'transfer data from ExcelWB to pptWorkSheet (i.e. the PowerPoint workbook)
' Apply styles to the chart.
With myChart
.ChartStyle = 4
.ApplyLayout 4
.ClearToMatchStyle
End With
' Add the axis title.
With myChart.Axes(xlValue)
.HasTitle = True
.AxisTitle.Text = "Units"
End With
'Apply data labels
myChart.ApplyDataLabels
Next xlWS
' Clean up the references.
Set pptWorkSheet = Nothing
' pptWorkBook.Application.Quit
Set pptWorkBook = Nothing
Set pptChartData = Nothing
Set myChart = Nothing
'Clean up Excel references.
Set xlApp = Nothing
'Option to close excel workbook
'ExcelWB.Close
End Sub

I think the problem you are running into is how PowerPoint and Excel store slide numbers and worksheet numbers. PowerPoint at least 3 different attributes with Slides, including "Slide IDs", "Slide Indexes" and "Slide Numbers". They are all different and make things a pain when you are trying to reference them. What I like to do is actually set the reference of the slide right when I am creating the slide:
Set CurSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutText)
This way right when you create the slide you now have a reference to it.
Additionally I find that using a number as a worksheet reference can also cause issues since if you reference the 5th worksheet it may not be the 5th worksheet at all. You have to look in the VBA editor of Excel to see what sheet gets what reference. However if you are able to refer to the worksheet name such as "Sheet1", "Sheet2", "OtherWorksheet" etc. You can make things a lot easier. To put this a little more in perspective if you make a sheet named "5" and then call the worksheet with.
Set ws = ActiveWorkBook.WorkSheets(5)
It will not work. You would need to use
Set ws = ActiveWorkBook.Worksheets("5")
Hopefully that makes sense. This part is not necessary but it makes debugging a lot easier if you do run into issues. The way I would recommend to do this is not in my code below because I don't have your workbook.
Set PPtWorkSheet = pptWorkBook.Worksheets("Sheet" & CurSlide.SlideIndex)
I re-wrote a few lines of your code and I was able to get it to work. However I do not have a copy of your workbook so I am not 100% sure this would work. Consider changing the worksheet names on your workbook if you still have trouble referencing the worksheet from the slide Index.
The revised code is below let me know if you have any questions.
Sub CreateChartAllWKs()
'Create variables
Dim myChart As Chart
Dim pptChartData As ChartData
Dim pptWorkBook As Excel.Workbook
Dim pptWorkSheet As Excel.Worksheet
Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlWS As Excel.Worksheet
Dim CurSlide As Slide 'new from update
' Create new excel instance and open relevant workbook
Set xlApp = New Excel.Application
xlApp.Visible = True 'Make Excel visable
Set xlWB = xlApp.Workbooks.Open("C:\filepath\ExcelData.xlsm", True, False) 'Open relevant workbook
'Loop through each worksheet in xlWB and transfer data to new pptWorkBook and
'create new PowerPoint chart
For Each xlWS In ActiveWorkbook.Worksheets
'Add a new slide where we will create the PowerPoint worksheet and chart
'Set CurSlide = ActivePresentation.Slides.Add ActivePresentation.Slides.Count + 1, ppLayoutText
ActiveWindow.View.GotoSlide ActivePresentation.Slides.Count
'This is my recommendation
Set CurSlide = ActivePresentation.Slides.Add(ActivePresentation.Slides.Count + 1, ppLayoutText)
' Create the chart and set a reference to the chart data.
Set myChart = CurSlide.Shapes.AddChart.Chart 'changed 8/19
Set pptChartData = myChart.ChartData
' Set the PowerPoint Workbook and Worksheet references.
Set pptWorkBook = pptChartData.Workbook
Set pptWorkSheet = pptWorkBook.Worksheets(CurSlide.SlideIndex) 'From Update
' Add the data to the PowerPoint workbook.
pptWorkSheet.ListObjects("Table1").Resize pptWorkSheet.Range("A1:B5")
pptWorkSheet.Range("Table1[[#Headers],[Series 1]]").Value = "Items"
pptWorkSheet.Range("a2:b5").Value = xlWB.ActiveSheet.Range("a2:b5").Value 'transfer data from ExcelWB to pptWorkSheet (i.e. the PowerPoint workbook)
' Apply styles to the chart.
With myChart
.ChartStyle = 4
.ApplyLayout 4
.ClearToMatchStyle
End With
' Add the axis title.
With myChart.Axes(xlValue)
.HasTitle = True
.AxisTitle.Text = "Units"
End With
'Apply data labels
myChart.ApplyDataLabels
Next xlWS
' Clean up the references.
Set pptWorkSheet = Nothing
' pptWorkBook.Application.Quit
Set pptWorkBook = Nothing
Set pptChartData = Nothing
Set myChart = Nothing
'Clean up Excel references.
Set xlApp = Nothing
'Option to close excel workbook
'ExcelWB.Close
End Sub

Related

How can I get data from powerpoint slide master

With the following code, I'm able to collect data from a slide and sent them to an excel sheet.
Unfortunately, I have some data that are writen in one of the layout of the slide master.
Do you know how can I access to those shapes and collect them in the same excel sheet?
Sub ExportMultiplePowerPointSlidesToExcel()
Dim PPTPres As Presentation
Dim PPTSlide As Slide
Dim PPTShape As Shape
Dim PPTTable As Table
Dim PPTPlaceHolder As PlaceholderFormat
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
Dim xlRange As Excel.Range
'Grab the Currrent Presentation.
Set PPTPres = Application.ActivePresentation
'Keep going if there is an error
On Error Resume Next
'Get the Active instance of Outlook if there is one
Set xlApp = GetObject(, "Excel.Application")
'If Outlook isn't open then create a new instance of Outlook
If Err.Number = 429 Then
'Clear Error
Err.Clear
'Create a new Excel App.
Set xlApp = New Excel.Application
'Make sure it's visible.
xlApp.Visible = True
'Add a new workbook.
Set xlBook = xlApp.Workbooks.Add
'Add a new worksheet.
Set xlWrkSheet = xlBook.Worksheets.Add
End If
'Set the Workbook to the Active
Set xlBook = xlApp.Workbooks("ExportFromPowerPointToExcel.xlsm")
'Set the Worksheet to the Active one, if Excel is already open.
Set xlWrkSheet = xlBook.Worksheets("Slide_Export")
'Loop through each Slide in the Presentation.
Set PPTSlide = ActivePresentation.Slides(1)
'Loop through each Shape in Slide.
For Each PPTShape In PPTSlide.Shapes
'If the Shape is a Table.
If PPTShape.Type = msoPlaceholder Or PPTShape.Type = ppPlaceholderVerticalObject Then
'Grab the Last Row.
Set xlRange = xlWrkSheet.Range("A20").End(xlUp)
'Handle the loops that come after the first, where we need to offset.
If xlRange.Value <> "" Then
'Offset by One rows.
Set xlRange = xlRange.Offset(1, 0)
End If
'Grab different Shape Info and export it to Excel.
xlRange.Value = PPTShape.TextFrame.TextRange
End If
Next
xlWrkSheet.Columns.ColumnWidth = 20
xlWrkSheet.Rows.RowHeight = 20
xlWrkSheet.Cells.HorizontalAlignment = xlLeft
xlApp.ActiveWindow.DisplayGridLines = False
End Sub
Thank you for your precious help
regards,
nicolas
You can access the master slide with the property SlideMaster. The data type is Master (not Slide). It has a Shape collection like a regular slide.
Dim PPTMaster As Master
Set PPTMaster = ActivePresentation.SlideMaster
For Each PPTShape In PPTMaster.Shapes
(...)
Next
If you want to avoid to duplicate your code that handles the shapes, put that part into a subroutine that gets either a single Shape or a Shape-Collection as parameter.
To get content from a particular layout:
Dim objLayout As CustomLayout
For Each objLayout In ActivePresentation.Designs(1).SlideMaster.CustomLayouts
If objLayout.Name = "Layout Name" Then
'Get the information here.
End If
Next objLayout
Even though the property name is CustomLayouts, the same code works for built-in Microsoft slide layouts as well.

Copy and Paste charts to slide in VBA

I'm creating a VBA code to copy a chart of a specific worksheet of Excel Workbook and paste it into a Power Point slide. Here's my code:
I'm getting an "runtime error '9' Subscript out of range" on ''Windows("FilenameExcel").Activate'' but I don't know what I'm doing wrong.
How do I solve the problem?
Sub copyPastePPT()
Dim MyPPT As Object
Dim xChart As Excel.ChartObject
Set MyPPT = CreateObject("Powerpoint.application")
Set myXLS = CreateObject("Excel.application")
FilenamePPT = OpenFileDialogPPT() 'Function to browse to a Power Point Presentation
FilenameExcel = OpenFileDialogXLS() 'Function to browse to a Excel Workbook
MyPPT.presentations.Open FilenamePPT
Workbooks.Open FilenameExcel
Windows("FilenameExcel").Activate
Sheets("Breakdown New").Select
ActiveSheet.ChartObjects.Select
ActiveChart.ChartArea.Copy
'Copy chart to a specific slide
Windows("FilenamePPT").Activate
MyPPT.ActiveWindow.View.GotoSlide (3)
MyPPT.ActivePresentation.Slides(3).Select
MyPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
MyPPT.CommandBars.ReleaseFocus
End Sub
Sub copyPastePPT()
Dim MyPPT As Object, wb, pp
Dim xChart As Excel.ChartObject
Set MyPPT = CreateObject("Powerpoint.application")
Set myXLS = CreateObject("Excel.application")
FilenamePPT = OpenFileDialogPPT() 'Function to browse to a Power Point Presentation
FilenameExcel = OpenFileDialogXLS() 'Function to browse to a Excel Workbook
Set pp = MyPPT.presentations.Open(FilenamePPT)
Set wb = Workbooks.Open(FilenameExcel)
pp.Sheets("Breakdown New").ChartObjects(1).Chart.ChartArea.Copy
'Copy chart to a specific slide
pp.Slides(3).Select
MyPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
MyPPT.CommandBars.ReleaseFocus
End Sub

I want to paste a copied cell block from Excel into a chart's data in a PPT presentation using VBA

I am writing a macro through Excel that will help me do the steps below. Currently, I am stuck at step 3.
'Copy specific cellblock in Excel sheet
'Open existing Powerpoint presentation (which exists of four slides with approximately 6-7 charts on each slides whose underlying data has to be replaced with the copied cellblock)
'Select specific chart on slide 1
'Open the specific chart's underlying data by right clicking on "Edit Data"
Select the cellblock in the sheet that pops up and replace it with the data that was copied from Excel in step 1
My issue at the moment lies in step 3, where I am not able to select any chart in my PowerPoint. I would also appreciate all guidance that could help me with step 4 and 5 as well.
My current code looks as the following:
Sub MyMacroRätt()
'Marks and copies a cell block in my Excel file
ActiveSheet.Range("R55", "T75").Select
Selection.Copy
'Open an existing PowerPoint file
Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application
PPT.Visible = True
PPT.Presentations.Open Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm"
Dim PPPres As PowerPoint.Presentation
Set PPPres = PPT.ActivePresentation
Dim pslide As PowerPoint.Slide
Dim pchart As PowerPoint.Chart
'Mark the first chart on the first slide
With ActiveWindow.Selection.ShapeRange(1)
If .HasChart = True Then
'Open Edit Data-sheet for selected chart
Chart.ActivateChartDataWindow
End If
End With
'Select existing data i Edit Data-sheet and replace with copied data from Excel
End Sub
Thanks Domenic, it actually worked!
Now I want to repeat this again for more charts in my PPT, so in the first step "Set rngCopyFrom = ActiveSheet.Range("R55", "T75") I will change the cell block that should be copied from Excel. However, when I will repeat the whole code you sent I also want to change the selected chart into THE SECOND CHART on the first slide in the PPT. Do you have ideas on how I can adjust this section so that it instead selects the second chart in slide 1, and pastes the new cell block into that charts worksheet?
If pptShape.HasChart Then 'first chart
In other words, I want a code that selects the second chart on slide 1, another code that selects the third chart on slide 1, another code that selects the fourth chart on slide 1..... and so on. In total I have 8 charts on each slide, and in total I have four slides with charts whose data that needs to be updated.
The following macro opens the specified PowerPoint file, activates the ChartData so that its workbook is opened, copies the specified data into the first worksheet of the workbook, starting at A2, and then closes it. You'll need to change the destination cell (A2) accordingly.
Option Explicit
Sub MyMacroRätt()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape
Dim rngCopyFrom As Range
Set rngCopyFrom = ActiveSheet.Range("R55", "T75")
Set pptApp = New PowerPoint.Application
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open(Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm")
With pptPres.Slides(1) 'first slide
For Each pptShape In .Shapes
If pptShape.HasChart Then 'first chart
Exit For
End If
Next pptShape
If Not pptShape Is Nothing Then
pptShape.Chart.ChartData.Activate
With rngCopyFrom
pptShape.Chart.ChartData.Workbook.Worksheets(1).Range("a2") _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
pptShape.Chart.ChartData.Workbook.Close
End If
End With
Set pptApp = Nothing
Set pptPres = Nothing
Set pptShape = Nothing
Set rngCopyFrom = Nothing
End Sub
Edit
To choose which chart to update, for example the second chart, try the following instead...
Option Explicit
Sub MyMacroRätt()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptShape As PowerPoint.Shape
Dim rngCopyFrom As Range
Dim ChartNum As Long
Dim ChartIndex As Long
ChartNum = 2 'second chart
Set rngCopyFrom = ActiveSheet.Range("R55", "T75")
Set pptApp = New PowerPoint.Application
pptApp.Visible = True
Set pptPres = pptApp.Presentations.Open(Filename:="C:\Users\seleveafe\Desktop\XXXXXX.pptm")
With pptPres.Slides(1) 'first slide
ChartIndex = 0
For Each pptShape In .Shapes
If pptShape.HasChart Then
ChartIndex = ChartIndex + 1
If ChartIndex = ChartNum Then
Exit For
End If
End If
Next pptShape
If Not pptShape Is Nothing Then
pptShape.Chart.ChartData.Activate
With rngCopyFrom
pptShape.Chart.ChartData.Workbook.Worksheets(1).Range("a2") _
.Resize(.Rows.Count, .Columns.Count).Value = .Value
End With
pptShape.Chart.ChartData.Workbook.Close
End If
End With
Set pptApp = Nothing
Set pptPres = Nothing
Set pptShape = Nothing
Set rngCopyFrom = Nothing
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