macro create excel table to powerpoint - excel

I am new to using VBA so there is a chance this has been done before but I cant find a discussion on this. I have a template ppt already created that I need tables to be added to specific slides (see image).
Would it be easier to create a table and run it into Powerpoint? or Connect it with a pre-existing table in PPT that can be populated?

There are a couple of options you have. You can either export the Excel Range as an OLE Object, a PowerPoint Table Object, or a Linked OLE Object. Each has its own advantages and disadvantages but, in your case, I would just paste it as a table if the formatting doesn't have to match exactly.
Here is some code that will demonstrate pasting a range of cells to PowerPoint, from Excel, using VBA.
Sub ExportMultipleRangeToPowerPoint_Method2()
'Declare PowerPoint Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim SldArray as Variant
'Declare Excel Variables
Dim ExcRng As Range
Dim RngArray As Variant
'Populate our array. This will define two ranges that exist in Sheet 1.
'This also populates our slide array which specifies which slide each range is pasted on.
'YOU WILL NEED TO CHANGE THIS IN ORDER FOR IT TO WORK ON YOURS!
RngArray = Array(Sheet1.Range("A1:F8"), Sheet1.Range("A10:F18"))
SldArray = Array(1, 2)
'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Loop through the range array, create a slide for each range, and copy that range on to the slide.
For x = LBound(RngArray) To UBound(RngArray)
'Set a reference to the range
Set ExcRng = RngArray(x)
'Copy Range
ExcRng.Copy
'Enable this line of code if you receive an error about the range not being in the clipboard - This will fix that error by pausing the program for ONE Second.
'Application.Wait Now + #12:00:01 AM#
'GRAB AN EXISTING SLIDE.
Set PPTSlide = PPTPres.Slide(SldArray(x))
'Paste the range in the slide as a Table (Default).
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
Next x
End Sub
Again, it really depends on how frequently you update it but most of the time I push people to keep it easier before making it harder. If you need more a step by step walkthrough, I do have a series on YouTube which you can follow along. It's especially helpful if you want to do more advanced stuff like positioning or even pasting as different data types. Here is the playlist: Excel to PowerPoint

Related

Excel to Powerpoint Table macro

I've been trying to build an Excel macro that can copy a range of numbers and paste that range into a Powerpoint table. I have the code below which appears to work super well but was hoping to add two tweaks to it//get help on how I can add the following functionality:
When it copies over to Powerpoint, it inputs the numbers with a bullet point before each number. Ideally, I'd love for it to paste the numbers over without any additional formatting.
Is there a way to copy the Excel coloring from Excel to the Powerpoint table? Right now, it just pastes the raw data without any formatting. But ideally, since a lot of the times I have colored conditional formatting on the Excel cells, this macro could copy each cells coloring and paste it into the Powerpoint table. (I was helped with some of the ExecuteMSO functions at the bottom of the code, but when I uncomment it/try to run it I get an error)
Right now, it requires the manual change of the Excel ranges to capture all the wanted data ("Range A3:J"). Is there a way to have Excel just copy the data within the highlighted/selected range so it can be flexible?
Really appreciate any help with this! (pasted the current code iteration below)
Public Sub Excel_to_PPT_Table()
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppTbl As PowerPoint.Shape
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If ppApp Is Nothing Then
Set ppApp = New PowerPoint.Application
Set ppPres = ppApp.Presentations.Item(1)
Else
Set ppPres = ppApp.Presentations.Item(1)
End If
ppApp.ActivePresentation.Slides(1).Select
ppPres.Windows(1).Activate
' find on Slide Number 1 which object ID is of Table type (you can change to whatever slide number you have your table)
With ppApp.ActivePresentation.Slides(1).Shapes
For i = 1 To .Count
If .Item(i).HasTable Then
ShapeNum = i
End If
Next
End With
' assign Slide Table object
Set ppTbl = ppApp.ActivePresentation.Slides(1).Shapes(ShapeNum)
' copy range from Excel sheet
iLastRowReport = Range("B" & Rows.Count).End(xlUp).Row
Range("A3:J" & iLastRowReport).Copy
' select the Table cell you want to copy to >> modify according to the cell you want to use as the first Cell
ppTbl.Table.Cell(3, 1).Shape.Select
' paste into existing PowerPoint table - use this line if you want to use the PowerPoint table format
ppApp.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle")
' paste into existing PowerPoint table - use this line if you want to use the Excel Range format
' ppApp.CommandBars.ExecuteMso ("PasteExcelChartSourceFormatting")
End Sub

VBA - Excel to powerpoint crashes for multiple ranges

I'm trying to create PowerPoint presentations automatically using Excel(ver 16.31) VBA on MacBook. I'm using the following code:
Sub ExportToPowerPoint()
'Declare PowerPoint variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
'Declare Excel Variables
Dim ExclRange As Range
Dim RangeArray As Variant
'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Create an Array that stores references to the ranges that we want to store
RangeArray = Array(Worksheets("Sheet1").Range("A1:N18"), Worksheets("Sheet2").Range("A1:I17"), Worksheets("Sheet3").Range("A1:J17"), Worksheets("Sheet4").Range("A1:J17"))
'Loop through this array, copy the range, create a new slide, and then paste the range to ther slide
For x = LBound(RangeArray) To UBound(RangeArray)
'Set a reference to the range we want to export
Set ExclRange = RangeArray(x)
'Copy the range
ExclRange.Copy
'Create the new slide in the Presentation - wait for a second
Set PPTSlide = PPTPres.Slides.Add(x + 1, ppLayoutBlank)
Application.Wait Now + TimeValue("00:00:01")
'Paste the range in the slide
PPTSlide.Shapes.Paste
Next x
End Sub
Seems like the code crashes at the last line PPTSlide.Shapes.Paste, when Powerpoint crashes and as a result Excel also hangs. If I comment out this line, 4 empty slides are created. Number of posts have mentioned to increase the wait time. However, even increasing wait time to 5 secs gives the same error.
Thanks in advance.

Is it possible to add new columns to powerpoint chart data with excel VBA?

I'm looking for a way to modify powerpoint chart data by adding/inserting new columns of data using VBA.
My problem is, every weeky i have an excel data to report with powerpoint slides. I have to follow the evolution of our service over the last four weeks. for example : << if we are on the week5 of work, i have to delete the week1 data and insert the Week5 data.>> I have to do that for many slides and comment everythings on powerpoint. then to do that manually, takes me lot of time. this is why i want to automate it.
'My VBA Code
Sub managePowerPointChart()
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide
Set oPPTApp = CreateObject("PowerPoint.Application")
oPPTApp.Visible = msoTrue
Set oPPTFile = oPPTApp.Presentations.Open(Filename:=ThisWorkbook.Path & "\powerpoint.pptx")
'Here I could modify a specific cell value
Set ChartData = oPPTFile.Slides(1).Shapes(1).Chart.ChartData
With ChartData
.Activate
.Workbook.Sheets(1).Range("D2").Value = 2020 'it's okay
.Workbook.Close
End With
'Here i want to insert another column into chart data
Set ChartData = oPPTFile.Slides(1).Shapes(1).Chart.ChartData
With ChartData
.Activate
.Workbook.Sheets(1).Columns("E").Insert Shift:=xlToLeft
.Workbook.Close
End With
oPPTFile.Close
End Sub
Here a Screenshot to what i want to do by VBA
Thanks for your helps.

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".

Resources