How to to add powerpoint slide titles?

Question

The code below takes the ranges specified in excel and imports the range to PowerPoint. My struggle is that i am trying to add a slide title for each slide in the code but the syntax below doesn’t work (Header1 = "test"). Can you help if possible? Thanks in advance!!

Sub export_to_powerpoint()
Dim PPAPP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Integer
Dim shptbl As Table
Set PPAPP = New PowerPoint.Application
Dim cht As Excel.ChartObject
Dim Header1 As String

PPAPP.Visible = True



'create new ppt:

Set PPPres = PPAPP.Presentations.Add


For ii = 1 To 10
PPPres.Slides.Add PPPres.Slides.Count + 1, ppLayoutTitleOnly



Next ii

PasteRng PPPres, 1, Range("A2:S24")
PPSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text

Header1 = "test" 'Titel on the first slide

PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100

PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue

PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True




PasteRng PPPres, 2, Range("A25:S47")

PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100

PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue

PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

PasteRng PPPres, 3, Range("v2:am24")

'Adjust the positioning of the Chart on Powerpoint Slide
PPAPP.ActiveWindow.Selection.ShapeRange.Left = 5
PPAPP.ActiveWindow.Selection.ShapeRange.Top = 100

PPAPP.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.8, msoTrue
PPAPP.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue

PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPAPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True




Set PPSlide = Nothing
Set PPPres = Nothing
Set PPAPP = Nothing
End Sub

Sub PasteRng(Pres, SlideNo, Rng As Range)
Rng.Copy ' copy the range
Pres.Application.ActiveWindow.View.GotoSlide SlideNo 'PPSlide.SlideIndex ' activate the slide no
Pres.Application.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse ' paste using pastespecial method
End Sub

Answer 1

Your code works. It's doing exactly what you asked it to do (which may differ from what you expect...), when you

Dim Header1 as String

You create a string variable, capable of holding a string data.

Then you assign to it:

Header1 = "test" 'Titel on the first slide

Nowhere in your code have you even attempted to use this string to write to a slide's title. you need to assign this to the slide's title object.

Header1 = "test" 

Dim sldTitle as Object
If Not ppSlide.Shapes.HasTitle Then

    'If there is no title object then assume the slideLayout does not permit one
    ' so do nothing.
Else:
    Set myTitle = ppSlide.Shapes.Title
    'Assign the title text:
    myTitle.TextFrame.TextRange.Characters.Text = Header1
End If

This will come in handy for you:

http://msdn.microsoft.com/en-us/library/office/ff743835(v=office.14).aspx