How to to add powerpoint slide titles?

StackOverflow https://stackoverflow.com/questions/23687622

  •  23-07-2023
  •  | 
  •  

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
Was it helpful?

Solution

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

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top