Excel VBA Introduction Part 28.1 - Creating PowerPoint Presentations 

Thank you Naima, glad you enjoyed that one!

Happy to hear that you enjoyed it, thanks for watching!

Thanks Manoj!

You are amazing. Thank you!

Thanks, this worked for me :) another way that worked is ppSlide.Shapes.PasteSpecial(ppPasteOLEObject).Select but that's for image only :)

Thanks Satish!

just one thing. I noticed you have a "chart1" object within your "Microsoft Excel Objects". I have a chart but it is not shown as an object. I only have "sheets" listed under my "Microsoft Excel objects". So i am having issues transferring the chart to powerpoint.

Thank you for this additional information! I couldn't figure out why my pivot charts weren't showing as objects. This is a great fix! Thanks!

Well I appreciate all of your hard work. Stick it somewhere on the list, I'll look forward to it if you ever get the time!

+WiseOwlTutorials Thank you very much Andrew for your quick reply which is a lot to be said with other channels on RU-vid where you never hear a reply. Again, you've really done a great job with your tutorials and I know it takes a lot of time to put them together. Just wanted to let you know that it's very nice of you and a lot of folks can really learn VBA from you. Have a super GREAT day!!!

Thank you for taking the time to answer, Andrew, I really appreciate it. I get no error when I use this code, but no shapes are selected after I activate. Also I am unsure of how to manipulate the shape properties through this loop. I tried to add "sh.TextFrame.TextRange.Font.Color = RGB(11, 52, 104)" I also experimented with using a with statement, but neither seems to not work. Any suggestions?

Hi Andrew yes the same happens when I try to change the Height property. I am using PowerPoint for mac 2011

Hi, I found the following worked for me rather than pasting as embedded object from excel into powerpoint try something like, worksheets("Sheet1").Range("A1:F30").CopyPicture (the key being CopyPicture) and when pasting into powerpoint a normal paste will work fine - not paste special. ppSlide.Shapes.Paste (my example was copying a chart into powerpoint as a picture so it could not be manipulated by end user of presentation)

maybe you can delete all the fields first and re-paste them

Hi Marcelo! I've added a video showing how to do this ru-vid.com/video/%D0%B2%D0%B8%D0%B4%D0%B5%D0%BE-UHE7p3ahtF4.html It's a members-only video at the moment but the basic premise involves looping through the PowerPoint files in a folder and using the InsertFromFile method to copy all the slides into the master presentation.

I'm not sure why you're seeing extra leading spaces, I don't see the same thing happening for me. I think it's easiest to change the alignment in Excel before copying into PowerPoint With Range("A1:D6") .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With But if that's not working, you can loop through the cells in the PowerPoint table after pasting it into the slide, something like this: Dim ppt As PowerPoint.Application Dim pres As PowerPoint.Presentation Dim sl As PowerPoint.Slide Dim cl As PowerPoint.CustomLayout Dim sh As PowerPoint.ShapeRange Dim tbl As PowerPoint.Table Dim rw As PowerPoint.Row Dim c As PowerPoint.Cell Set ppt = New PowerPoint.Application Set pres = ppt.Presentations.Add Set cl = pres.SlideMaster.CustomLayouts(7) Set sl = pres.Slides.AddSlide(1, cl) Range("A1").CurrentRegion.Copy Set sh = sl.Shapes.Paste Set tbl = sh.Table For Each rw In tbl.Rows For Each c In rw.Cells With c.Shape.TextFrame2 .VerticalAnchor = msoAnchorMiddle .HorizontalAnchor = msoAnchorCenter End With Next c Next rw

@@WiseOwlTutorials Hi thank you for this mate. I actually thought of hte same approaches. Excel has numbers and text with perfect formatting. when pasted into PowerPoint i keep getting those leading spaces and reck the alignment. So I fix the issue by looping through table cells in PowerPoint but given I am doing a large number of export it is time-consuming. I am searching the topic. Until now I haven't figured out a way at least to do the alignment to the table in PowerPoint but by selecting the whole table and do the formatting as you would manually. Insofar what worked for this is to change cell by cell

@@ahmed007Jaber It's so strange that you get these leading spaces, I've never seen that happen before! At least you have a workaround but let me know if you find a better solution!

@@WiseOwlTutorials will do for sure. I programme in R and i just found about possibilities with VBA so i am learning a lot about it now

How can i get the template filr?

***** He wants to see it as chart because he thinks picture type is unprofessional. I create a solution but it is not efficient. i copy the chart in ppt which i add everytime the macro runs. After tahn break thr link and copy it at the background. It works but i think it is not efficient. Do you think is there a better way like this? Thanks in advance

+WiseOwlTutorials OK

+WiseOwlTutorials Just for the record Andrew, you're doing a great job and your accent is great. Actually keeps me inspired to hear you talk. Keep up the good work and don't worry about nay sayers!

Hi Alisher! I believe the ApplyTemplate method only applies to Microsoft templates docs.microsoft.com/en-us/office/vba/api/powerpoint.presentation.applytemplate I believe (although haven't tried it) that you can use the ApplyTheme method to apply custom themes or templates docs.microsoft.com/en-us/office/vba/api/powerpoint.presentation.applytheme I hope it helps!

@@WiseOwlTutorials Thanks, but I am still getting the same error.

@@alishernarzulloyev3855 Hi Alisher, sorry I don't know what the problem is in that case.

Thank you a lot Andrew for your answer, indeed you're absolutly right, this is a good method to fix this problem. Thanks a lot. +

Sorry I don't know of any way to do that.

Super , Thank a lot. ^_^

Hi Andrew, I seem to get an error even after trying this out. Could you help me out with a fix for this?

I had this problem too. This reply fixed it. Thanks!

i have it all finished except the code to change the questions and answers. What i want by the end is a form attached to a sheet to input the questions and answers and a button to add the new questions and answers into the boxes.

Thank you for the response, will I attach it here or will I email and if it email would you have email I can send it to

Hi wise owl thank for your willingness to help. Here is the error I encounter and the code I used. Run-time error'-2147188160(80048240)': Selection (unknown member):Invalid request. Nothing appropriate is currently selected. My Code Sub CreateNewPresentation() ' This section is were you set variables Dim ppapp As PowerPoint.Application Dim ppPres As PowerPoint.Presentation Dim ppslide As PowerPoint.Slide ' This section is to make Excel aware of Powerpoint Set ppapp = New PowerPoint.Application ppapp.Visible = True ppapp.Activate 'This section is about adding slide, the intro slide and populating each of the text boxes of slide with text data Set ppPres = ppapp.Presentations.Add Set ppslide = ppPres.Slides.Add(1, ppLayoutTitle) ' Here the instruction will be to input text into each of the boxes of the slide in Powerpoint ppslide.Shapes(1).TextFrame.TextRange.Text = "Excel to Powerpoint Demo" ppslide.Shapes(2).TextFrame.TextRange.Text = "By J" ' This section is to add new blank slide and set range to copy and paste data from Excel into Powerpoint. Plus align to fit slide Set ppslide = ppPres.Slides.Add(2, ppLayoutBlank) ppslide.Select Range("A1").CurrentRegion.Copy ppslide.Shapes.PasteSpecial ppPasteOLEObject 'This section deals with alignment of the data within the Powerpoint slide ppslide.Shapes(1).Width = ppPres.PageSetup.SlideWidth ppslide.Shapes(1).Left = 0 ppapp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, msoTrue End Sub

Thank you that worked. Now continue with the rest of the video

Hi wise owl I am down to getting a chart from excel to power point bunt when I follow the instruction - set ppslide = ppPres.Slide.add(3, ppLayoutBlank) Ppslide.select Chart1.chartArea.copy I get error Method or data member not found My apologises for all the messages.

Hi It is slides.add, sorry about the typo in my messages. The debug line is related to chart1.ChartArea.Copy line. I went back to earlier teachings of yours and used a work around based of them instructions. I added in the likes of worksheets(2).select and used this command Activesheets.ChartObjects("Chart 1").Activate ActiveChart.chartArea.Copy This works I am not sure why, found it via goggle, as I don't want to be taken advantage of your good nature. But what happens is it does not generate PowerPoint in the order I want. So if I add worksheet(3) using this active Chart command, the slide will appear as slide two and so on.

Thanks! Would you possibly know how to start writing in that opened template?

How would I set the code so that I can Copy and Paste into the powerpoint? doing ppslide = pppres.slides does not work and also just trying to copy and paste into the slide with ppslide(3) does not work as well. (slide number is 3). I have also tried a number of different stuff but it did not work. Do you know how to set the code so I can start copying and pasting? Sorry being such an inconvenience but your help would be amazing.

Hey, Thanks for the help. But it says an object required? Do you know anything to fix this?

***** : Thanx, Im being able to do that. Your video was quite useful. Thnx for help

***** hey. i wana know another thing. Im trying to calculate last row and last column value and copying to another sheet, but since i want to copy multiple value from same sheet and copy and paste them on different sheet so that i could paste them on ppt. im not able to select them all at once. can u help? this is the code: Sub CopyPaste() Dim ppApp1 As PowerPoint.Application Dim ppApp2 As PowerPoint.Application Dim PPSlide1 As PowerPoint.Slide Dim PPPres1 As PowerPoint.Presentation Dim rng1 As Excel.Range Dim oPPShape1 As Object Dim newslide1 As PowerPoint.SlideRange Dim tb1 As PowerPoint.Shape Dim otable1 As Table Dim iRow1 As Integer Dim iColumn1 As Integer Dim myMschart1 As PowerPoint.Chart Dim LastRow1 As Long Dim LastColumn1 As Long Dim val1 As Variant Dim PPPres2 As PowerPoint.Presentation 'opening up powerpoint "Q3 2014 Basel Model Tracking IEC.pptx" If ppApp1 Is Nothing Then Set ppApp1 = New PowerPoint.Application ppApp1.Visible = True 'If ppApp2 Is Nothing Then Set ppApp2 = New PowerPoint.Application 'ppApp2.Visible = True Set PPPres1 = ppApp1.Presentations.Open("C:\.pptm") ppApp1.Visible = True 'Set PPPres2 = ppApp2.Presentations.Open("C:\.pptx") 'ppApp2.Visible = True 'opening up workbook with specified name 'Workbooks.Open "C:\.xlsm" Worksheets("Overall EAD").Activate 'MsgBox Format(Worksheets("z").Cells(4, 4).Value, "0.00%") 'LastRow1 = Worksheets("z").Cells(Rows.Count, "A").End(xlUp).Row 'MsgBox LastRow1 'Search for any entry, by searching backwards by Columns. 'LastColumn1 = Worksheets("z").Cells(8, Columns.Count).End(xlToLeft).Column 'MsgBox LastColumn1 LastRow1 = ActiveSheet.Range("D7").End(xlDown).Row LastColumn1 = ActiveSheet.Range("E8").End(xlToRight).Column 'LastRow2 = ActiveSheet.Range("AA7").End(xlDown).Row 'LastColumn2 = ActiveSheet.Range("AA8").End(xlToRight).Column 'MsgBox LastRow1 'MsgBox LastColumn1 'This line is showing error, since I cant do this. what's the option? Worksheets("z").Range("Cells(LastRow1, LastColumn1), Cells(LastRow1, LastColumn1)", "Cells(LastRow1, LastColumn1), Cells(LastRow1, LastColumn1)").Select 'Worksheets("z").Range(Cells(LastRow1, LastColumn1), Cells(LastRow1, LastColumn1)).Select Selection.Copy Sheets("sheet1").Activate Range("j1").Select ActiveSheet.Paste Worksheets("sheet1").Range("J1").Activate 'copying the data from excel to powerpoint PPPres1.Slides(7).Shapes(2).Table.Cell(3, 5).Shape.TextFrame.TextRange.Text = Format(ActiveCell.Value, "0.00%") 'PPPres1.Slides(7).Shapes(2).Table.Cell(3, 4).Shape.TextFrame.TextRange.Text = Format(Worksheets("Bucket Accuracy LGD").Cells(LastRow1, LastColumn1).Value, "0.00%") 'Workbooks.Open "C:\hello.xlsx" 'Worksheets("z").Activate 'Range("G4").Activate 'PPPres.Slides(8).Shapes(2).Table.Cell(2, 4).Shape.TextFrame.TextRange.Text = Format(ActiveCell.Value, "0.00%") 'Clear The Clipboard Application.CutCopyMode = False End Sub

***** : i have done that, but the thing is, i have to generalized few things in this code. for Eg: in this line, im putting up the range "AA7" and so no. there is something that I can do, so that I can copy last cell in a row until blank such that I dont need to hard code it in the program. 'LastRow2 = ActiveSheet.Range("AA7").End(xlDown).Row 'LastColumn2 = ActiveSheet.Range("AA8").End(xlToRight).Column 'MsgBox LastRow1 here is new code: Sub ExceltoPpt() Dim ppApp1 As PowerPoint.Application Dim ppApp2 As PowerPoint.Application Dim PPSlide1 As PowerPoint.Slide Dim PPPres1 As PowerPoint.Presentation Dim oPPShape1 As Object Dim newslide1 As PowerPoint.SlideRange Dim tb1 As PowerPoint.Shape Dim otable1 As Table Dim iRow1 As Integer Dim iColumn1 As Integer Dim myMschart1 As PowerPoint.Chart Dim LastRow1 As Long Dim LastColumn1 As Long Dim LastRow2 As Long Dim LastColumn2 As Long Dim LastRow3 As Long Dim LastColumn3 As Long Dim val1 As Variant Dim rng1 As Range, rng2 As Range, rng3 As Range Dim PPPres2 As PowerPoint.Presentation 'opening up powerpoint "Q3 2014 Basel Model Tracking IEC.pptx" If ppApp1 Is Nothing Then Set ppApp1 = New PowerPoint.Application ppApp1.Visible = True Set PPPres1 = ppApp1.Presentations.Open("C:\Users\kgupt48\Desktop\Data automation\Q4 2014 Basel Model Tracking IEC.pptm") ppApp1.Visible = True Worksheets("Overall EAD").Activate ' have to automate this With Sheets("Overall EAD") LastRow1 = ActiveSheet.Range("D7").End(xlDown).Row LastColumn1 = ActiveSheet.Range("E8").End(xlToRight).Column LastRow2 = ActiveSheet.Range("AB7").End(xlDown).Row LastColumn2 = ActiveSheet.Range("AB8").End(xlToRight).Column LastRow3 = ActiveSheet.Range("AV7").End(xlDown).Row LastColumn3 = ActiveSheet.Range("AV8").End(xlToRight).Column MsgBox LastRow1 MsgBox LastColumn1 MsgBox LastRow2 MsgBox LastColumn2 MsgBox LastRow3 MsgBox LastColumn3 Set rng1 = .Cells(LastRow1, LastColumn1) Set rng2 = .Cells(LastRow2, LastColumn2) Set rng3 = .Cells(LastRow3, LastColumn3) Set rngunion = Union(rng1, rng2, rng3) rngunion.Select Selection.Copy End With Sheets("sheet1").Activate Range("J1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Selection.NumberFormat = "0.00%" 'copying the data from excel to powerpoint- automate value PPPres1.Slides(8).Shapes(2).Table.Cell(3, 5).Shape.TextFrame.TextRange.Text = Format(Worksheets("Sheet1").Range("J1").Value, "0.00%") 'PPPres1.Slides(7).Shapes(2).Table.Cell(3, 4).Shape.TextFrame.TextRange.Text = Format(Worksheets("Bucket Accuracy LGD").Cells(LastRow1, LastColumn1).Value, "0.00%") 'PPPres.Slides(8).Shapes(2).Table.Cell(2, 4).Shape.TextFrame.TextRange.Text = Format(ActiveCell.Value, "0.00%") 'Clear The Clipboard Application.CutCopyMode = False End Sub

Komal Gupta hey, or could you tell me a method so that I can copy last cell value before every blank cell for many rows in a single sheet. I hope you must have understood by the code I just have sent you. I cant hard code the value. or should I save my excel in some other? In short, in any case, i dont want to mention any range, just row and column if possible.

No. Im trying to copy a last cell value from each row where the data is present and then copying that value to another sheet and then from there im copying to ppt slides on a particular table cell

Hi, we don't have a video on this but it isn't too difficult to do - the code below assumes you have a presentation saved in the same folder as the Excel workbook: Sub ModifyPresentation() Dim ppt As PowerPoint.Application Dim pres As PowerPoint.Presentation Dim sld As PowerPoint.Slide Dim shp As PowerPoint.Shape Set ppt = New PowerPoint.Application Set pres = ppt.Presentations.Open(ThisWorkbook.Path & "\MyPresentation.pptx") Set sld = pres.Slides(1) Set shp = sld.Shapes(2) shp.TextFrame2.TextRange.Text = "Created on " & Format(Date, "dddd d mmmm yyyy") pres.Save End Sub I hope that helps!

@@WiseOwlTutorials hey WiseOwl I found another tutorial on youtube and have now found a solution to my problem Thank you very much for your fast reply and the code, I'll definitely try yours out as well Keep up the good work, thank you for your efforts and your channel :)

Great! Happy to hear that you found a solution and thanks for watching!

Hi Koushik, here's one way to do it. The code assumes you have text in cells A1:A5 on Sheet1 and that you want to create a new presentation rather than refer to an existing one: Sub CreatePresAndCopyTable() Dim ppt As PowerPoint.Application Dim pres As PowerPoint.Presentation Dim cl As PowerPoint.CustomLayout Dim sl As PowerPoint.Slide Dim sh As PowerPoint.ShapeRange 'Create a new presentation Set ppt = New PowerPoint.Application Set pres = ppt.Presentations.Add 'Reference a CustomLayout and create a slide using it Set cl = pres.SlideMaster.CustomLayouts(7) 'a blank slide Set sl = pres.Slides.AddSlide(1, cl) Sheet1.Range("A1:D6").Copy 'Various techniques to paste Set sh = sl.Shapes.Paste 'paste as a PowerPoint table 'Set sh = sl.Shapes.PasteSpecial(ppPasteText) 'text 'Set sh = sl.Shapes.PasteSpecial(ppPasteRTF) 'rich text format 'Set sh = sl.Shapes.PasteSpecial(ppPasteOLEObject) 'embedded Excel object 'Set sh = sl.Shapes.PasteSpecial(ppPasteMetafilePicture) '16 bit image 'Set sh = sl.Shapes.PasteSpecial(ppPasteEnhancedMetafile) '32 bit image 'Move the shape to the top left corner of the slide sh(1).Top = 0 sh(1).Left = 0 End Sub I hope it helps!

it actually says 445 in both Run Time Erros. Not -214724809 (80070057)

Hi, if you have a single presentation open you can do this: Dim ppt As PowerPoint.Application Dim pres As PowerPoint.Presentation Set ppt = GetObject(Class:="PowerPoint.Application") Set pres = ppt.Presentations(1) Debug.Print pres.Name I hope it helps!

@@WiseOwlTutorials I will try this out thank you for help❤️

@@sagargondage6266 No problem!

yes, for exemple i have a details of contract in access (Reference of the contract, title, duration, etc and i want to copy these informations for one contract in the pp.

***** , Thank you for your respond. It works! Now, Im facing font size problem Somehow I cant change font size and name the way u did Example: ppSlide1.shapes(1).TextFrame.TextRange.Font.Name = "Calibri" ppSlide1.shapes(1).TextFrame.TextRange.Font.Size = 30 This method work for titles, not for pasted text as tab But I found difficult way to change font size and name My code: ActiveSheet.Range("A2:A28").Copy ppSlide2.Select ppApp.ActiveWindow.View.Paste ppSlide2.shapes(1).Height = 450 ppSlide2.shapes(1).Width = 170 ppSlide2.shapes(1).Left = 20 ppSlide2.shapes(1).Top = 20 Dim i As Integer For i = 1 To 25 ppSlide2.Select ppSlide2.shapes(1).Table.Cell(i, 1).Shape.TextFrame.TextRange.Font.Size = 11 ppSlide2.shapes(1).Table.Cell(i, 1).Shape.TextFrame.TextRange.Font.Name = "Calibri" Next i The problem is it takes too much time, changing cell one by one. Do we have other methods to change font size for pasted tab quickly? Thank you!

***** , yes i've tried to change font size in the excel, but when it pastes to powerpoint slide,it changes font size depending on table size, as u see below ppSlide2.shapes(1).Height = 450 ppSlide2.shapes(1).Width = 170 ppSlide2.shapes(1).Left = 20 ppSlide2.shapes(1).Top = 20 Im not stuck with iterating through cells, it works, but it takes about 30-40 sec. to finish font size changing, and i was looking for faster way to accomplish it. ok, anyway it works and im ok with it! Thank you for providing me necessary information, appreciate! Best!

To add to my previous note, I am not able to open a new powerpoint application. Look forward to hear some solution to my problem. Thanks,Manish

thank's a lot, it Works perfectly

Hi, this is really fantastic to learn Excel VBA. I love it :D. Regarding this run-time error, it still doesn't work by using ppSlides.Shapes.PasteSpecial ppPasteOLEObject. Is there other workaround for me to take?

Many thanks for quick reply :-) Sorry, just realized that you mentioned this error with "ppSlide.Shapes.Paste" on Excel 2010. I was running this VBA code on that version. Here are test results. 1. Range("A1").CurrentRegion.Copy ppSlide.Shapes.Paste [Test Result] runtime error. Shapes(unknown member): Invalid request. Clipboard is empty or contains data which may not be pasted here 2. Range("A1").CurrentRegion.Copy ppSlide.Shapes.PasteSpecial ppPasteOLEObject [Test Result] Excel and Powerpoint both stopped so killed these processes in Task Manager 3. Range("A1").CurrentRegion.Copy ppSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile [Test Result] It works! 4. Range("A1").CurrentRegion.CopyPicture ppSlide.Shapes.Paste [Test Result] It works! May I ask what caused this error and what is difference among them?

Hi Andrew, i too got the same error and i tried Range("A1").CurrentRegion.CopyPicture ppSlide.Shapes.Paste My question is why .copy is not working here and .copyPicture is working Pls clarify

you are great Andrew, you solve my problem with this statement beause I have the same problem, now my code works perfectly

Thank You

***** Hi Andrew, This is perfect, Its really great help. Its working. Thanks, KP