PowerPoint VBA select slide

Question

My goal is to creat ppt via VBA. I have already the template in my desktop that i need to use. This part of the code is ok.

However I did not find how to select slides in the ppt. I try many ways and i get all the times error.

If someone could help me.

Option Explicit

Sub CreatePowerPoint()

Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape

Dim oPA As PowerPoint.Application
Dim oPP As PowerPoint.Presentation
Dim oPS As PowerPoint.SlideRange
Dim strTemplate As String
Dim rng As Range

strTemplate = "C:\Users\290866\Desktop\vba\PPT\Template.potx"

Set oPA = New PowerPoint.Application
oPA.Visible = msoTrue
oPA.Presentations.Open strTemplate, untitled:=msoTrue

If Not oPS Is Nothing Then Set oPS = Nothing
If Not oPP Is Nothing Then Set oPP = Nothing
If Not oPA Is Nothing Then Set oPA = Nothing


Err_PPT:
If Err <> 0 Then
MsgBox Err.Description
Err.Clear
Resume Next
End If

Set rng = ThisWorkbook.Sheets("Credit Recommendation").Range("B2:N59")

ActivePresentation.Slides (1)
  rng.Copy
mySlide.Shapes.PasteSpecial (ppPasteBitmap)
  Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
myShapeRange.LockAspectRatio = msoFalse
      myShapeRange.Left = 20
      myShapeRange.Top = 80
      myShapeRange.Height = 400
 myShapeRange.Width = 680
  Application.CutCopyMode = False


End Sub

Thank you!!!

You are not binding your slide to your varribale. Replace ActivePresentation.Slides (1) with set mySlide = ActivePresentation.Slides(1) — Evan
Hello Evan, thank you for your answer. I replaced the line but now I have an error: "ActiveX component can't create object" — manu
Maybe you can help me by adding a line... How would I add search and replace for all slides? — manu

Evan Evan · Accepted Answer · 2015-07-27T12:01:28

Here is your code modified to work. I eplain the modifications below

Option Explicit

Sub CreatePowerPoint()
    Dim mySlide As PowerPoint.Slide
    Dim myShapeRange As PowerPoint.Shape

    Dim oPA As PowerPoint.Application
    Dim oPP As PowerPoint.Presentation
    Dim oPS As PowerPoint.SlideRange
    Dim strTemplate As String
    Dim rng As Range

    strTemplate = "C:\Users\290866\Desktop\vba\PPT\Template.potx"

    Set oPA = New PowerPoint.Application
    oPA.Visible = msoTrue
    'changed this line to assign the new presentation to your varriable
    Set oPP = oPA.Presentations.Open(strTemplate, untitled:=msoTrue)


    'If Not oPS Is Nothing Then Set oPS = Nothing
    'If Not oPP Is Nothing Then Set oPP = Nothing
    'If Not oPA Is Nothing Then Set oPA = Nothing

Err_PPT:
    If Err <> 0 Then
    MsgBox Err.Description
    Err.Clear
    Resume Next
    End If

    Set rng = ThisWorkbook.Sheets("sheet1").Range("B2:N59")

    Set mySlide = oPP.Slides(1)
    rng.Copy
    mySlide.Shapes.PasteSpecial (ppPasteBitmap)
    Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
        myShapeRange.LockAspectRatio = msoFalse
        myShapeRange.Left = 20
        myShapeRange.Top = 80
        myShapeRange.Height = 400
        myShapeRange.Width = 680
    Application.CutCopyMode = False
End Sub

You were declaring varriables and never setting them equal to anyhting. I still did not see where oPS was ever used.

You recieved the ActiveX error because PowerPoint did not have an active presentation. It is always safer to work with your own objects rather than ActiveAnything within Office. So I set oPP equal to your new presentation and then used oPP rather than ActivePresentaiton

Also you never need to set things equal to nothing unless you're being picky about the order it happens. Everything declared in the Sub is set to nothing at the end of the sub.

Hope this helps!

Edit: Search and Replace

This is where I got the code, but I modified it to work as a callable Sub because I was calling it from different places many times:

'Find and Replace function
Sub FindAndReplace(sFind As String, sReplace As String, ByRef ppPres As PowerPoint.Presentation)
    Dim osld As PowerPoint.Slide
    Dim oshp As PowerPoint.Shape
    Dim otemp As PowerPoint.TextRange
    Dim otext As PowerPoint.TextRange
    Dim Inewstart As Integer

    For Each osld In ppPres.Slides
        For Each oshp In osld.Shapes
            If oshp.HasTextFrame Then
                If oshp.TextFrame.HasText Then
                    Set otext = oshp.TextFrame.TextRange
                    Set otemp = otext.Replace(sFind, sReplace, , msoFalse, msoFalse)
                    Do While Not otemp Is Nothing
                        Inewstart = otemp.Start + otemp.Length
                        Set otemp = otext.Replace(sFind, sReplace, Inewstart, msoFalse, msoFalse)
                    Loop
                End If
            End If
        Next oshp
    Next osld
End Sub

You'll have to pass it the 2 strings and the Presentation object. It'll look like this in your Sub

FindAndReplace("FindMe","ReplaceWithThis", oPP)

PowerPoint VBA select slide

1 Answers

Edit: Search and Replace