Need help making powerpoint automation

srocks124

New Member
Joined
Aug 24, 2018
Messages
3
I have been working on this VBA code but I keep getting the error '-2147024809(80070057)' The specified value is out of range.
Not sure why.
I'm trying to copy values from the excel sheet to a powerpoint presentation for an awards ceremony.
Any help would be appreciated. I'm using excel and powerpoint 2010, but will probably converting it to work on a more updated version when I am finished.

This is my code so far
Code:
Option Explicit


    Dim PPPres As PowerPoint.Presentation
    Dim PPApp As PowerPoint.Application
    Dim PPSlide As PowerPoint.Slide
    Dim ppTextbox As PowerPoint.Shape
    Dim Slidecount As Long
    Dim ppColumn As Integer
    Dim TemplatePath As String
    Dim Timeline As PowerPoint.Timeline
    
    


Sub CreateMyPostSecondaryPowerpoint()


    Set PPApp = CreateObject("Powerpoint.Application")
    
    PPApp.Visible = msoTrue
    PPApp.Activate
    
    Set PPPres = PPApp.Presentations.Add
 
 'Add the Format Sub here
 
 'First Slide
 
    Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitle)
    PPSlide.Shapes(1).TextFrame.TextRange = "Awards Ceremony"
    PPSlide.Shapes(2).TextFrame.TextRange = "Conference 2019"
 
    Slidecount = PPPres.Slides.Count
     
    ppColumn = 1
    
    Call SequenceEvents1
    
    ppColumn = 2
    
    Call SequenceEvents1
    
    ppColumn = 3
    
    Call SequenceEvents1
    
    ppColumn = 4
    
    Call SequenceEvents1
    
    ppColumn = 5
    
    Call SequenceEvents1
    
    ppColumn = 6
    
    Call SequenceEvents1
    
    ppColumn = 7
    
    Call SequenceEvents1
    
    ppColumn = 8
    
    Call SequenceEvents1
    
 End Sub




 Sub SequenceEvents1()
 
 'Add Event slide
 
 Slidecount = PPPres.Slides.Count
 
    Set PPSlide = PPPres.Slides.Add(Slidecount + 1, ppLayoutTitle)
        
    PPSlide.Select
    Range("A20").Offset(0, ppColumn).Copy
    PPSlide.Shapes(1).TextFrame.TextRange.Paste


Slidecount = PPPres.Slides.Count


'Transition between slides
    With PPSlide.SlideShowTransition
    
        .Speed = ppTransitionSpeedFast
        .EntryEffect = ppEffectWedge
        .AdvanceOnTime = msoTrue
        .AdvanceTime = 3
    
    End With


'Add top 3 slide
    Set PPSlide = PPPres.Slides.Add(Slidecount + 1, ppLayoutTitleOnly)
    
    PPSlide.Select
    
    Range("A20").Offset(0, ppColumn).Copy
    PPSlide.Shapes(1).TextFrame.TextRange.Paste
    
'Call the places
    
    Call AddEachPlace1
    
 End Sub
 
 
Sub AddEachPlace1()


Call ThirdPlace1
Call SecondPlace1
Call FirstPlace1


End Sub


    
Sub ThirdPlace1()


    'Third Place
    
    Set ppTextbox = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 350, 300, 50)
    
    PPSlide.Shapes(2).TextFrame.TextRange = "Third Place"
    PPSlide.Shapes(2).TextFrame.TextRange.Font.Size = 40


        
    'Shape Animation
    With ppTextbox.AnimationSettings
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0.5
            .EntryEffect = ppEffectFlyFromLeft
    End With
    
    
    'Third Place Name
    
    Range("A23").Offset(0, ppColumn).Copy
    Set ppTextbox = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 365, 350, 50)
    
    PPSlide.Shapes(3).TextFrame.TextRange.Paste
    PPSlide.Shapes(3).TextFrame.TextRange.Font.Size = 30
    
    'Shape Animation
        With ppTextbox.AnimationSettings
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0.5
            .EntryEffect = ppEffectFlyFromLeft
        End With
End Sub


Sub SecondPlace1()


    'Second Place
    
    Set ppTextbox = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 250, 300, 50)
    
    PPSlide.Shapes(4).TextFrame.TextRange = "Second Place"
    PPSlide.Shapes(4).TextFrame.TextRange.Font.Size = 40
    
    'Shape Animation
    With ppTextbox.AnimationSettings
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 1.5
            .EntryEffect = ppEffectFlyFromLeft
    End With
    
    'Second Place Name
    
    Range("A22").Offset(0, ppColumn).Copy
    Set ppTextbox = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 265, 350, 50)
    
    PPSlide.Shapes(5).TextFrame.TextRange.Paste
    PPSlide.Shapes(5).TextFrame.TextRange.Font.Size = 30
    
        'Shape Animation
        With ppTextbox.AnimationSettings
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0.5
            .EntryEffect = ppEffectFlyFromLeft
        End With
End Sub


Sub FirstPlace1()
  'First Place
    
    Set ppTextbox = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 150, 300, 50)
    
    PPSlide.Shapes(6).TextFrame.TextRange = "First Place"
    PPSlide.Shapes(6).TextFrame.TextRange.Font.Size = 40
    
    'Shape Animation
        With ppTextbox.AnimationSettings
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 1.5
            .EntryEffect = ppEffectFlyFromLeft
        End With
        
         'First Place Name
    
    Range("A21").Offset(0, ppColumn).Copy
    Set ppTextbox = PPSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 300, 165, 350, 50)
    
    PPSlide.Shapes(7).TextFrame.TextRange.Paste
    PPSlide.Shapes(7).TextFrame.TextRange.Font.Size = 30
        
        'Shape Animation
        With ppTextbox.AnimationSettings
            .AdvanceMode = ppAdvanceOnTime
            .AdvanceTime = 0.5
            .EntryEffect = ppEffectFlyFromLeft
        End With


End Sub
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
You need to establish where code is failing and then you can determine why

(Instead of running the code like you normally do)
- {Alt}{F11} takes you to VBA window
- click on View \ select Locals Window
- click on your procedure (CreateMyPostSecondaryPowerpoint) and run the code one line at a time with {F8}
- the failing point will be obvious and the Locals Window (which monitors variable values as they change) may reveal something useful
 
Upvote 0

Forum statistics

Threads
1,223,896
Messages
6,175,259
Members
452,626
Latest member
huntinghunter

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top