OK, here it goes..
Sub PP()
Const ppLayoutTitle As Integer = 1
Const ppLayoutText As Integer = 2
Const ppLayoutTitleOnly As Integer = 11
Const ppEffectFlyFromTop As Integer = 3330
Const ppEffectBoxIn As Integer = 3074
Const ppSlideShowUseSlideTimings As Integer = 2
Const ppEffectRandom As Integer = 513
Const ppWindowMaximized As Integer = 3
Const ppEffectCheckerboardDown As Integer = 1026
Const ppAdvanceOnTime As Integer = 2
Const ppAnimateByWord As Integer = 1
Const ppAnimateByFirstLevel As Integer = 1
Const ppEffectBoxOut As Integer = 3073
Dim Pres1 As Object
Dim Slide1 As Object
Dim Shape1 As Object
Dim Shape2 As Object
Dim Shape3 As Object
Dim Shape4 As Object
Dim Shape5 As Object
Dim Picture1 As Object
Dim SlideNum As Integer
Dim x As Variant
tehdas = Sheets("Lib").Range("L2")
Set PPTApp = CreateObject("PowerPoint.Application")
ActivePresentation.ApplyTemplate "C:\Documents and Settings\kaikkoa\Application Data\Microsoft\Templates\Templates\EasyDOC(FinINTL)\A4p_customer.pot"
With PPTApp
.Visible = True
.WindowState = ppWindowMaximized
Set Pres1 = PPTApp.Presentations.Add
End With
Set Slide1 = Pres1.Slides.Add(1, ppLayoutTitleOnly)
With Slide1
With .Shapes(1)
.Top = 120
With .TextFrame.TextRange
.Text = "Hedging levels for " & tehdas & Chr(13) & _
"2007-2010"
.Font.Size = 54
End With
End With
End With
x = 0
For x = 0 To 2
SlideNum = Pres1.Slides.Count + 1
Set Slide1 = Pres1.Slides.Add(SlideNum, ppLayoutTitleOnly)
PPTApp.ActiveWindow.View.GotoSlide SlideNum
Next
Sheets("Main page").ChartObjects("Chart 10").CopyPicture
With PPTApp.ActivePresentation.Slides(2).Shapes
With .PasteSpecial(DataType:=ppPasteMetafilePicture, Link:=False, DisplayAsIcon:=False)
.Height = 1350
.Width = 625
.Left = 50
.Top = 110
End With
End With
Sheets("2007").Range("A1:O38").Copy
With PPTApp.ActivePresentation.Slides(3).Shapes
With .PasteSpecial(DataType:=ppPasteMetafilePicture, Link:=False, DisplayAsIcon:=False)
.Height = 1350
.Width = 625
.Left = 50
.Top = 110
End With
End With
End Sub
