How to to add powerpoint slide titles? - vba

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