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
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