VBA to export Excel worksheet to PowerPoint slides

VBA to Export Excel sheet to PowerPoint:

Hi experts,

I am using the following VBA to export my worksheet to PowerPoint presentation, however if I change the slicer in my Pivot Chart and export again the worksheet, the code is creating a new presentation, rather than a new slide.

I would like to add the new selection into the same presentation, just adding as a new slide.

I believe I need a loop indexing and counting the slides.

Any suggestions, please.


VBA Code:

Sub ExceltoPowerPoint()

Dim PowerPointApp As Object
Dim myPresentation As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim namecheck As Range

Set PowerPointApp = GetPowerPointApp()
Set myPresentation = PowerPointApp.Presentations.Add

Call ExportResourcePlanSlide(myPresentation, ThisWorkbook.ActiveSheet.Range("a2:m40"))

PowerPointApp.Visible = True
PowerPointApp.Activate

Application.CutCopyMode = False

End Sub



Function GetPowerPointApp() As Object

On Error Resume Next
Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Err.Clear
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Function
End If
Set GetPowerPointApp = PowerPointApp
On Error GoTo 0

End Function


Sub ExportResourcePlanSlide(ByVal myPresentation As Object, ByRef rng As Range)

'Create new slide------------------------------------------------------------------------------------------------------

Set myslide = myPresentation.Slides.Add(myPresentation.Slides.Count + 1, 12) '11 = ppLayoutTitleOnly

'Copy range and paste to powerpoint------------------------------------------------------------------------------------

rng.Copy
myslide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile

'Add Commentary Text Box-----------------------------------------------------------------------------------------------

Set myTextBox = myslide.Shapes.AddTextbox(1, Left:=100, Top:=100, Width:=8.19 * 28.3465, Height:=350)

With myTextBox
.TextFrame.TextRange.Text = ""
.TextFrame.TextRange.Font.Size = 10
.Left = 24.9 * 28.3465
.Top = 3.18 * 28.3465
End With

End Sub
Guilherme BarbosaAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Ryan ChongSoftware Team Lead, ex-Business Systems Analyst , ex-Senior Application EngineerCommented:
you may try this:

If PowerPointApp.Presentations.Count > 0 Then
    Set myPresentation = PowerPointApp.Presentations(1) 'Default to first opened powerpoint
Else
    Set myPresentation = PowerPointApp.Presentations.Add
End If

Open in new window

Ryan ChongSoftware Team Lead, ex-Business Systems Analyst , ex-Senior Application EngineerCommented:
similarly, you could also output to most recent opened powerpoint by doing this:

Set myPresentation = PowerPointApp.Presentations(PowerPointApp.Presentations.Count)

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Guilherme BarbosaAuthor Commented:
Hi Ryan,

Thank you for your suggestion, but it didn't worked, can you please tell me in which part of the code I should include your code?

That is the way I did:

***************************************

Sub ExceltoPowerPoint()

Dim PowerPointApp As Object
Dim myPresentation As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim namecheck As Range

Set PowerPointApp = GetPowerPointApp()
Set myPresentation = PowerPointApp.Presentations.Add
 
  Call ExportResourcePlanSlide(myPresentation, ThisWorkbook.ActiveSheet.Range("a2:m40"))

  PowerPointApp.Visible = True
  PowerPointApp.Activate

  Application.CutCopyMode = False
 
End Sub



Function GetPowerPointApp() As Object

  On Error Resume Next
      Set PowerPointApp = GetObject(class:="PowerPoint.Application")
      Err.Clear
      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Function
      End If
      Set GetPowerPointApp = PowerPointApp
  On Error GoTo 0
 
End Function


Sub ExportResourcePlanSlide(ByVal myPresentation As Object, ByRef rng As Range)

    Set myPresentation = PowerPointApp.Presentations(PowerPointApp.Presentations.Count)

'Create new slide------------------------------------------------------------------------------------------------------
   
    Set mySlide = myPresentation.Slides.Add(myPresentation.Slides.Count + 1, 12) '11 = ppLayoutTitleOnly
 
'Copy range and paste to powerpoint------------------------------------------------------------------------------------
 
  rng.Copy
  mySlide.Shapes.PasteSpecial DataType:=2  '2 = ppPasteEnhancedMetafile
 
'Add Commentary Text Box-----------------------------------------------------------------------------------------------

  Set myTextBox = mySlide.Shapes.AddTextbox(1, Left:=100, Top:=100, Width:=8.19 * 28.3465, Height:=350)
 
  With myTextBox
    .TextFrame.TextRange.Text = ""
    .TextFrame.TextRange.Font.Size = 10
    .Left = 24.9 * 28.3465
    .Top = 3.18 * 28.3465
  End With

End Sub
HTML5 and CSS3 Fundamentals

Build a website from the ground up by first learning the fundamentals of HTML5 and CSS3, the two popular programming languages used to present content online. HTML deals with fonts, colors, graphics, and hyperlinks, while CSS describes how HTML elements are to be displayed.

Ryan ChongSoftware Team Lead, ex-Business Systems Analyst , ex-Senior Application EngineerCommented:
try amend your sub: ExceltoPowerPoint() to:

Sub ExceltoPowerPoint()

Dim PowerPointApp As Object
Dim myPresentation As Object
Dim wb As Workbook
Dim ws As Worksheet
Dim namecheck As Range

Set PowerPointApp = GetPowerPointApp()

If PowerPointApp.Presentations.Count > 0 Then
    Set myPresentation = PowerPointApp.Presentations(PowerPointApp.Presentations.Count)
Else
    Set myPresentation = PowerPointApp.Presentations.Add
End If
  
  Call ExportResourcePlanSlide(myPresentation, ThisWorkbook.ActiveSheet.Range("a2:m40"))

  PowerPointApp.Visible = True
  PowerPointApp.Activate

  Application.CutCopyMode = False
  
End Sub

Open in new window


it tested working for me.
Guilherme BarbosaAuthor Commented:
Awesome Ryan!! It is working now!! Thanks so much!!
Guilherme BarbosaAuthor Commented:
Thank you Ryan for your prompt feedback and help!! Really appreciate it!

Cheers,
Gilly
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.