VBA copy excel data range to powerpoint - excel

I'm new to VBA/macro's and I want to copy a specific data range in excel to powerpoint. I have searched this website for codes and I found something that goes in the good direction (see link below), but I can't adjust it well enough to make it work since I don't know enough of the language.
What I need is a code that selects 1 column range (>150 cells) in Excel and pastes every individual cell to an existing powerpoint file from slide 3 and onward (cell A3 to slide 3, A4 to slide 4, etc) in the right corner.
copy text from Excel cell to PPT textbox
My version crashes when I try for example:
ThisWorkbook.Sheets("RMs").Range("A3:A8").Value
The problem might be that I don't specify the shape well enough and/or give a proper range of slides.
If anyone can help me I would be most grateful, thanks in advance.

I written down some slight modification of the existing code from the link you gave above that complies with your needs.
Be aware that you will need to have the presentation with the slides already saved and ready to be filled with data from Excel.
After pasting the cell in each slide based on your logic of cell A3 in slide 3 you can move the newly created shapes with the coordinates of left and top.
Code:
Option Explicit
Sub Sammple()
Dim oPPApp As Object, oPPPrsn As Object, oPPSlide As Object
Dim oPPShape As Object
Dim FlName As String
Dim i as integer
'~~> Change this to the relevant file
FlName = "C:\MyFile.PPTX"
'~~> Establish an PowerPoint application object
On Error Resume Next
Set oPPApp = GetObject(, "PowerPoint.Application")
If Err.Number <> 0 Then
Set oPPApp = CreateObject("PowerPoint.Application")
End If
Err.Clear
On Error GoTo 0
oPPApp.Visible = True
'~~> Open the relevant powerpoint file
Set oPPPrsn = oPPApp.Presentations.Open(FlName)
for i=3 to ThisWorkbook.Sheets("RMs").Range("A65000").end(xlup).row
'~~> Change this to the relevant slide which has the shape
Set oPPSlide = oPPPrsn.Slides(i)
'~~> Write to the shape
ThisWorkbook.Sheets("RMs").Range("A" & i).CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
oPPSlide.Shapes.Paste.Select
'
'~~> Rest of the code
'
End Sub

As Catalin's already mentioned, you must first create the presentation and add enough slides to hold the data you want to paste.
Sub AddSlideExamples()
Dim osl As Slide
With ActivePresentation
' You can duplicate an existing slide that's already set up
' the way you want it:
Set osl = .Slides(1).Duplicate(1)
' Or you can add a new slide based on one of the presentation
' master layouts:
Set osl = .Slides.AddSlide(.Slides.Count + 1, .Designs(1).SlideMaster.CustomLayouts(1))
End With
End Sub

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

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

How to paste excel data into a powerpoint table already existing in a presentation

I need to paste a large range of data from Excel (say A1:B2000) into a powerpoint presentation, with each slide having a table with 40 rows of data from excel in it. I am struggling to finally paste the range into the table in powerpoint.
In more detail, I have worked on 2 possible solutions: A) pasting the Excel data as a new table into a powerpoint slide, and then reformat it; or B), as requested here because I think it should be the better solution, pasting the Excel data into existing tables in powerpoint.
I have the code to copy a range and select a cell within a table in a powerpoint slide into which I want to paste the range of excel cells, but I do not know how to do the final step, pasting the Excel data into the powerpoint table.
Private Sub pptpaste2()
Dim r As Range
Dim powerpointapp As PowerPoint.Application
Dim mypresentation As Object
Dim myslide As Object
Dim myshape As Object
Dim pptLayout As CustomLayout
Dim ppTbl As Object
'code to insert excel rows into tables already existing in powerpoint presentation slides
Set r = ThisWorkbook.Worksheets("listdata").Range("B3:C11")
Set powerpointapp = GetObject(class:="PowerPoint.Application")
Set mypresentation = powerpointapp.Presentations("RoughVBApres.ppxt")
Set pptLayout = mypresentation.Slides(3).CustomLayout
Set myslide = mypresentation.Slides(3)
powerpointapp.Visible = True
powerpointapp.Activate
If powerpointapp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'copy range in excel that you want to paste into table on powerpoint
r.Copy
'Make the presentation the active presentation
mypresentation.Windows(1).Activate
Application.CutCopyMode = False
' find on Slide Number 3 which object ID is of Table type
With powerpointapp.ActivePresentation.Slides(3).Shapes
For i = 1 To .Count
If .Item(i).HasTable Then
ShapeNum = i
End If
Next
End With
' assign Slide Table object
Set ppTbl = powerpointapp.ActivePresentation.Slides(3).Shapes(ShapeNum)
' select the Table cell you want to copy to
ppTbl.Table.Cell(1, 1).Shape.Select
I believe I have done all of the code up to finally pasting the data into the powerpoint slide table.
I have tried
powerpointapp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
and variants of that which are suggested elsewhere online, but this doesn't seem to work. I would like guidance as to how to finally paste my copied range into the existing table in powerpoint, if this is possible.
Thank you in advance.

macro create excel table to powerpoint

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

Excel to PowerPoint PasteSpecial and Keep Source Formatting

I'm trying to copy and paste a range from an Excel document into a PowerPoint slide.
It is copying the range as an image rather than keeping source formatting.
oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide
On Error Resume Next
Set XLApp = GetObject(, "Excel.Application")
On Error GoTo 0
Windows("File1.xlsx").Activate
Sheets("Sheet1").Select
Range("B3:N9").Select
Selection.Copy
oPPTApp.ActiveWindow.View.GotoSlide (2)
oPPTApp.ActiveWindow.Panes(2).Activate
oPPTApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteOLEObject
oPPTApp.ActiveWindow.Selection.ShapeRange.Left = 35
oPPTApp.ActiveWindow.Selection.ShapeRange.Top = 150
Let’s break this problem into a few different parts:
Creating the PowerPoint Application
Copying the Charts Pasting the
Charts as the right format.
Now looking at your code, you are pretty much good to go on the first two. It’s pasting the object that is causing the problem. Let’s explore the different ways to paste.
USING THE EXECUTEMSO METHOD:
When we use this method it’s like we are right-clicking on the slide and pasting the object on to the slide. Now while this method is a completely valid way to paste, achieving this in VBA can be a little challenging. The reason why is because it is extremely volatile, and we must slow down our script to a snail’s pace!
To implement this method along with any of its different options, do the following:
'Create a new slide in the Presentation, set the layout to blank, and paste range on to the newly added slide.
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO SELECT THE SLIDE
For i = 1 To 5000: DoEvents: Next
PPTSlide.Select
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO PASTE THE OBJECT
For i = 1 To 5000: DoEvents: Next
PPTApp.CommandBars.ExecuteMso "PasteSourceFormatting"
PPTApp.CommandBars.ReleaseFocus
'PASTE USING THE EXCUTEMSO METHOD - VERY VOLATILE
'Paste As Source Formatting
'PPTApp.CommandBars.ExecuteMso "PasteSourceFormatting"
'Paste as Destination Theme
'PPTApp.CommandBars.ExecuteMso "PasteDestinationTheme"
'Paste as Embedded Object
'PPTApp.CommandBars.ExecuteMso "PasteAsEmbedded"
'Paste Excel Table Source Formatting
'PPTApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
'Paste Excel Table Destination Theme
'PPTApp.CommandBars.ExecuteMso "PasteExcelTableDestinationTableStyle"
Now if you look at my code, I had to pause it two different times to make sure it would work. This is because VBA will move way too fast otherwise and all that will happen is it will paste all the objects on the first slide! If we are only doing one paste we are usually safe without putting in the pauses, but the minute you want to go to a new slide put the pauses in!
USING THE REGULAR PASTE METHOD:
When we use this method, it’s like we are pressing Crtl+V and it will simply paste the object as a regular shape in PowerPoint. The regular shape means the default paste type in PowerPoint. Here is how we can implement a simple paste method:
'PASTE USING PASTE METHOD - NOT AS VOLATILE
'Use Paste method to Paste as Chart Object in PowerPoint
PPTSlide.Shapes.Paste
USING THE PASTE SPECIAL METHOD:
When we use this method it’s like we are pressing Ctrl+Alt+V on the keyboard and we get all sorts of different options of how to paste it. It ranges from a picture all the way to an embedded object that we can link back to the source workbook.
With the paste special method, sometimes we will still have to pause our scripts. The reason why is like the reason I mentioned above, VBA is volatile. Just because we copy it doesn’t mean it will make it to our clipboard. This problem can pop up and then disappear at the same time, so our best bet is to have a pause in our script to give VBA enough time to put the information in the clipboard. It usually doesn’t have to be a long pause but only a second or 2. Here is how we implement the paste special method with the different options we can use:
'PASTE USING PASTESPECIAL METHOD - NOT AS VOLATILE
'Paste as Bitmap
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteBitmap
'Paste as Default
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteDefault
'Paste as EnhancedMetafile
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
'Paste as HTML - DOES NOT WORK WITH CHARTS
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteHTML
'Paste as GIF
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteGIF
'Paste as JPG
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteJPG
'Paste as MetafilePicture
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
'Paste as PNG
PPTSlide.Shapes.PasteSpecial DataType:=ppPastePNG
'Paste as Shape
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteShape
'Paste as Shape, display it as an icon, change the icon label, and make it a linked icon.
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteShape, DisplayAsIcon:=True, IconLabel:="Link to my Chart", Link:=msoTrue
'Paste as OLEObject and it is linked.
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
With all that being said, if you paste an object as an OLEObject with a link most of the time the formatting comes over with it. Unless you have a special theme that only exist in Excel, that’s where you get into trouble. I ran into this problem when I was taking a chart from Excel To Word, but the Excel chart had a custom theme.
Here is your code, rewritten so that it will paste an object using the source format and setting the dimensions of it. I hope you don't mind me readjusting some of your code to make it a little more concise.
Sub PasteRangeIntoPowerPoint()
'Declare your variables
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTShape As PowerPoint.Shape
Dim oPPTSlide As PowerPoint.Slide
Dim Rng As Range
'Get the PowerPoint Application, I am assuming it's already open.
Set oPPTApp = GetObject(, "PowerPoint.Application")
'Set a reference to the range you want to copy, and then copy it.
Set Rng = Worksheets("Sheet1").Range("B3:N9")
Rng.Copy
'Set a reference to the active presentation.
Set oPPTFile = oPPTApp.ActivePresentation
'Set a reference to the slide you want to paste it on.
Set oPPTSlide = oPPTFile.Slides(3)
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO SELECT THE SLIDE
For i = 1 To 5000: DoEvents: Next
oPPTSlide.Select
'WARNING THIS METHOD IS VERY VOLATILE, PAUSE THE APPLICATION TO PASTE THE OBJECT
For i = 1 To 5000: DoEvents: Next
oPPTApp.CommandBars.ExecuteMso "PasteSourceFormatting"
oPPTApp.CommandBars.ReleaseFocus
For i = 1 To 5000: DoEvents: Next
'Set the dimensions of your shape.
With oPPTApp.ActiveWindow.Selection.ShapeRange
.Left = 35
.Top = 150
End With
End Sub
For that case, I have always been happy using Copy picture in Excel. To get it, click the arrow next to Copy.
In VBA, it translates to
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
In older versions of Excel (2003 and previous) you need to click Shift+Edit to get that option.
Have you tried using
oPPTApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
Try this solution instead of using the Shapes.PasteSpecial method:
https://stackoverflow.com/a/19187572/1467082
PPTApp.CommandBars.ExecuteMso "PasteExcelChartSourceFormatting"
This does not create a link to the Excel document, it embeds a local copy of the document in the PowerPoint Presentation. I think I understand this is your requirement.
This is a code of mine that Keeps Source Formatting:
Sub SigAcc()
Application.ScreenUpdating = False
Dim myPresentation As Object
Set myPresentation = CreateObject("PowerPoint.Application")
Dim PowerPointApp As Object
Dim PPTApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Set objPPApp = New PowerPoint.Application
Set PPSlide = myPresentation.ActivePresentation.Slides(2)
lastrow = ThisWorkbook.Worksheets("The worksheet you would like to copy").Range("Letter of longest column (E.I. "A")" & Rows.Count).End(xlUp).Row
For p = PPSlide.Shapes.Count To 1 Step -1
Set myShape = PPSlide.Shapes(p)
If myShape.Type = msoPicture Then myShape.Delete
Next
Set myPresentation = myPresentation.ActivePresentation
Set mySlide = myPresentation.Slides(2)
On Error Resume Next
'assigning range into variable
Set r = ThisWorkbook.Worksheets("Sheet to copy").Range("A1:C" & lastrow)
On Error Resume Next
'If we have already opened powerpoint
Set PowerPointApp = GetObject(Class:="PowerPoint.Application")
'If Powerpoint is not opened
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="Powerpoint.Application")
r.Copy
'to paste range
PPApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
mySlide.Shapes.PasteSpecial
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
'Set position:
myShape.left = ActivePresentation.PageSetup.SlideWidth / 2 - ActivePresentation.PageSetup.SlideWidth / 2
myShape.Top = 80
PowerPointApp.Visible = True
PowerPointApp.Activate
'to clear the cutcopymode from clipboard
Application.CutCopyMode = False
End Sub
I had the same problem and was very annoyed that Excel wouldn't allow pasting the table with the CommandBars method. Moreover, none of the suggested solutions seemed to work for me.
Now, I have found a satisfying solution using the GetPastedShape function from Jamie Garroch, found here. At least it is applicable in cases where you already have a formatted table in place and only need to update the values.
The basic idea is to paste the table unformatted (which works fine), copy every single cell from the unformatted table to the desired formatted table that is already in place in your PPT. Afterwards the unformatted table is deleted. So when you're running the code you won't take notice that there was a temporary "support" table in your PPT.
Applied to your code the solution looks as follows:
Windows("File1.xlsx").Activate
Sheets("Sheet1").Select
Range("B3:N9").Select
Selection.Copy
ActivePresentation.Slides(1).Shapes.Paste
wb.Close SaveChanges:=False
Tab_unformatted = GetPastedShape.Name ' this is the Function from Jamie Garroch
For i = 1 To UBound(Tab_formatted, 1)
For j = 1 To UBound(Tab_formatted, 2)
ActivePresentation.Slides(1).Shapes("Tab_formatted").Table.Cell(i, j).Shape.TextFrame.TextRange.Text = _
ActivePresentation.Slides(1).Shapes(Tab_unformatted).Table.Cell(i, j).Shape.TextFrame.TextRange.Text
Next
Next
ActivePresentation.Slides(1).Shapes(Tab_unformatted).Delete

Resources