CODEWITHSUNDEEP
vbaexcel
rjara
rjara

Reputation: 7

Set Title in PowerPoint using VBA

i'm new at macros and i'm trying to export some data from Excel to a PowerPoint Presentation. I need to put some cells from Excel as Titles in PowerPoint. Here is my code:

    Sub CrearPresentacion2()

'Iniciar las variables
Dim rng As Excel.Range
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim myShapeRange As PowerPoint.ShapeRange

'Pedir al usuario un rango de celdas
Set rng = Application.InputBox("Seleccione el Rango para hacer Presentación", Title:="Seleccionar Rango", Type:=8)
On Error Resume Next

'Hacer PowerPoint visible
PowerPointApp.Visible = True
PowerPointApp.Activate

'Crear Nueva Presentacion
Set myPresentation = PowerPointApp.Presentations.Add

'Ciclo para copiar cada celda en una diapositiva
For Each Cell In rng.Cells
    Cell.Select
    Selection.Copy
    Dim ppSlide2 As PowerPoint.Slide
    Dim x As Integer
    x = myPresentation.Slides.Count + 1
    If x = 1 Then
        Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutBlank)
        PowerPointApp.ActivePresentation.Slides(x).Select
        PowerPointApp.ActiveWindow.Selection.SlideRange.Select
        Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText)
        Dim Header1 As String
        Header1 = "Example"
        Set myTitle = ppSlide2.Shapes.Title
        myTitle.TextFrame.TextRange.Characters.Text = Header1
    ElseIf x = 2 Then
        Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutBlank)
        PowerPointApp.ActivePresentation.Slides(x).Select
        PowerPointApp.ActiveWindow.Selection.SlideRange.Select
        Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText)
    Else
        Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutText)
        PowerPointApp.ActivePresentation.Slides(x).Select
        PowerPointApp.ActiveWindow.Selection.SlideRange.Select
        Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText)
    End If
Next Cell

CutCopyMode = False

When the counter is Equal to 1, I need to insert an "Example" title, but it says that "myTitle" object doesn't exist. In the second case, I need to put the cell as a Title, but I don't know how to use the function

ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText)

Thanks for your help.

Upvotes: 0

Views: 8056

Answers (1)

David Zemens
David Zemens

Reputation: 53623

For the first problem, you are using Layout:=ppLayoutBlank which does not have a Title shape. You should use a layout which contains a Title shape.

I will use ppLayoutTitleOnly but you could use any layout which contains a title shape.

For the second case, let's store the value of Cell as a string variable, and use that to write to the slide's title shape. There is no need to use Copy method. I'm also going to recommend moving your declarations to the top of your code -- VBA doesn't process DIM statements conditionally, so there's no good reason to put them inside your loop, and it only makes them harder to find later if you need to modify something.

Note this code is incomplete, and as such has not been tested.

Dim titleText As String
Dim ppSlide2 As PowerPoint.Slide
Dim x As Integer
Dim Header1 As String

PowerPointApp.Visible = True
PowerPointApp.Activate

'Crear Nueva Presentacion
Set myPresentation = PowerPointApp.Presentations.Add


'Ciclo para copiar cada celda en una diapositiva
For Each Cell In rng.Cells
    titleText = Cell.Value

    x = myPresentation.Slides.Count + 1
    If x = 1 Then
        Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutTitleOnly)
        PowerPointApp.ActivePresentation.Slides(x).Select
        PowerPointApp.ActiveWindow.Selection.SlideRange.Select
        Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText)
        Header1 = "Example"
        Set myTitle = ppSlide2.Shapes.Title
        myTitle.TextFrame.TextRange.Characters.Text = Header1
    ElseIf x = 2 Then
        Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutTitleOnly)
        PowerPointApp.ActivePresentation.Slides(x).Select
        PowerPointApp.ActiveWindow.Selection.SlideRange.Select
        ' not sure what this next line does so I omit it
        'Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText)
        Set myTitle = ppSlide2.Shapes.Title
        '## Insert the titleText from Cell variable in this slide's Title shape:
        myTitle.TextFrame.TextRange.Characters.Text = titleText
    Else
        Set ppSlide2 = myPresentation.Slides.Add(Index:=x, Layout:=ppLayoutText)
        PowerPointApp.ActivePresentation.Slides(x).Select
        PowerPointApp.ActiveWindow.Selection.SlideRange.Select
        Set myShapeRange = ppSlide2.Shapes.PasteSpecial(DataType:=ppPasteText)
    End If
Next Cell

CutCopyMode = False

Upvotes: 2

Related Questions