create a PowerPoint with VBA

[jamiguel77]

hi, how to create a powerpoint document wit vba any link, any advice.

thanks

 

[Domenic]

You can use the following code to create a new PowerPoint presentation, and add a blank slide. I have include two versions of the code. The first one uses early binding, whereas the second one uses late binding. For early binding, you'll need to set a reference to the PowerPoint object library...

VBE >> Tools >> References >> Microsoft PowerPoint x.0 Object Library

Here's the code that uses early binding...

Option Explicit

Sub CreatePowerPointPresentation()


    'Set a reference to the PowerPoint object library for early binding
    'VBE >> Tools >> References >> Microsoft PowerPoint x.0 Object Library


    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    
    On Error Resume Next
    'Get an instance of PowerPoint, if it already exists
    Set ppApp = GetObject(, "PowerPoint.Application")
    If ppApp Is Nothing Then
        'Create a new instance of PowerPoint, since one does not already exist
        Set ppApp = CreateObject("PowerPoint.Application")
        'Make PowerPoint visible
        ppApp.Visible = True
    End If
    On Error GoTo 0
    
    'Create a new PowerPoint presentation
    Set ppPres = ppApp.Presentations.Add
    
    'Add a blank slide to the presentation
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)
    
    'Do stuff here
    '
    '
    
    'Clear from memory
    Set ppApp = Nothing
    Set ppPres = Nothing
    Set ppSlide = Nothing
    
End Sub

For late binding...

Option Explicit

Sub CreatePowerPointPresentation()


    Dim ppApp As Object 'PowerPoint.Application
    Dim ppPres As Object 'PowerPoint.Presentation
    Dim ppSlide As Object 'PowerPoint.Slide
    
    On Error Resume Next
    'Get an instance of PowerPoint, if it already exists
    Set ppApp = GetObject(, "PowerPoint.Application")
    If ppApp Is Nothing Then
        'Create a new instance of PowerPoint, since one does not already exist
        Set ppApp = CreateObject("PowerPoint.Application")
        'Make PowerPoint visible
        ppApp.Visible = True
    End If
    On Error GoTo 0
    
    'Create a new PowerPoint presentation
    Set ppPres = ppApp.Presentations.Add
    
    'Add a blank slide to the presentation
    Set ppSlide = ppPres.Slides.Add(1, 12) 'ppLayoutBlank
    
    'Do stuff here
    '
    '
    
    'Clear from memory
    Set ppApp = Nothing
    Set ppPres = Nothing
    Set ppSlide = Nothing
    
End Sub

Hope this helps!

 

[jamiguel77]

Thanks for answer, i test....

Is possible share with me something like this:

1) i have on my excel file a Graph named: "Budget" something like this:




Dim cht As ChartObject
Set rng = Range("A3:B5")
Set cht = NewSheet.ChartObjects.Add( _
Left:=200, _
Width:=370, _
Top:=7, _
Height:=260)
'cht.Chart.ChartType = xlPie
cht.Chart.SetSourceData Source:=rng
'cht.Chart.ChartType = xlPie
cht.Chart.ChartType = xlDoughnut
cht.Chart.HasTitle = True
cht.Chart.ChartTitle.Text = "Budget 2018"
'cht.Chart.SetElement msoElementDataLabelBestFit
cht.Chart.SetElement msoElementDataLabelShow
cht.Name = "xBudget"

and i want copy the Chart to a Power Point, have other 2 charts... and want copy to a new slide..


also if have something for copy a range of data to power point.

Much much thanks.

Really..

 

[Domenic]

To copy your chart to the slide, try...

    'Copy chart
    cht.Chart.ChartArea.Copy
    
    'Paste chart into slide
    ppSlide.Shapes.Paste
    With ppSlide
        Set ppShape = .Shapes(.Shapes.Count)
    End With
    
    'Set properties for shape
    With ppShape
        'etc
        '
        '
    End With

To copy your range to the slide...

    'Copy range (change the range accordingly)
    Range("A2:B5").CopyPicture appearance:=xlScreen, Format:=xlPicture
    
    'Paste range into slide
    ppSlide.Shapes.Paste
    With ppSlide
        Set ppShape = .Shapes(.Shapes.Count)
    End With
    
    'Set properties for shape
    With ppShape
        'etc
        '
        '
    End With

Note that you should declare ppShape. So, if you're using early binding, you would declare it like this...

Dim ppShape As PowerPoint.Shape

If you're using late binding, you would declare it this way...

Dim ppShape As Object

 

[jamiguel77]

Worked the code....
PAsted the Chart, but 3 questions:

1) how to paste more charts? (i have 6 charts by moment), and align, resize the chart object?
2) change color of a Slide?
3) how to add more slides? (i think: Set ppSlide = ppPres.Slides.Add(1, 12) 'ppLayoutBlank) but not do the work.... the Shape is on second slide, and i add the slide after paste the Chart.


Here my code.....

Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppSlide As PowerPoint.Slide
    Dim ppShape As Object 'PowerPoint.Shape
    On Error Resume Next
    'Get an instance of PowerPoint, if it already exists
    Set ppApp = GetObject(, "PowerPoint.Application")
    If ppApp Is Nothing Then
        'Create a new instance of PowerPoint, since one does not already exist
        Set ppApp = CreateObject("PowerPoint.Application")
        'Make PowerPoint visible
        ppApp.Visible = True
    End If
    On Error GoTo 0
    
    'Create a new PowerPoint presentation
    Set ppPres = ppApp.Presentations.Add
    
    'Add a blank slide to the presentation
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)
    
'Copy chart
    Set NewSheet = wbk.Sheets("Graficas")
    Set cht = NewSheet.ChartObjects("xBudget")
    cht.Chart.ChartArea.Copy
    
    'Paste chart into slide
    ppSlide.Shapes.Paste
    With ppSlide
        Set ppShape = .Shapes(.Shapes.Count)
    End With
    
    'Set properties for shape
    With ppShape
      .Left = 40
      .Top = 30
      .Height = 200
      .Width = 250
        'etc
        '
        '
    End With
    Set ppSlide = ppPres.Slides.Add(1, 12) 'ppLayoutBlank
    'Do stuff here
    '
    '
    
    'Clear from memory
    Set ppApp = Nothing
    Set ppPres = Nothing
    Set ppSlide = Nothing

Thanks

 

[areed1192]

I'm going to use some code that I posted somewhere else, but I think it should do the job for you.

Now in this code, we are using arrays to store all of our information, so you will need to populate the arrays with the necessary info in order for this to work. The reason I chose arrays was that it sounded like each chart had its own unique dimensions that it had to be.

The only thing is that you need to make sure you put everything in the right order when populating the arrays, in other words, the first elements in all the dimension arrays should be for the first chart in the chart array.

Let me know if you have any questions and I'll be happy to answer them

Sub CreatePowerPointPres()


Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape As PowerPoint.Shape

Dim cht As ChartObject
Dim ChtArray As Variant
Dim TopArray, LeftArray, HeightArray, WidthArray As Variant





    On Error Resume Next
    
    'Get an instance of PowerPoint, if it already exists
    Set ppApp = GetObject(, "PowerPoint.Application")
    
    If ppApp Is Nothing Then
    
        'Create a new instance of PowerPoint, since one does not already exist
        Set ppApp = CreateObject("PowerPoint.Application")
            ppApp.Visible = True
            
    End If
    
    On Error GoTo 0
    
    'Create a new PowerPoint presentation
    Set ppPres = ppApp.Presentations.Add
    
    'Add a blank slide to the presentation
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)
    
    'Define the charts we want to export along with their corresponding dimensions
    ChtArray = Array(Sheet1.ChartObjects(1), Sheet1.ChartObjects(2), Sheet1.ChartObjects(3))
    
    LeftArray = Array(50, 528, 50, 528)
    TopArray = Array(70, 70, 300, 300)
    HeightArray = Array(50, 528, 50, 528)
    WidthArray = Array(70, 70, 300, 300)
    
    For x = LBound(ChtArray) To UBound(ChtArray)
    
        'Create a reference to the chart and copy it.
        Set cht = ChtArray(x)
        cht.Copy
        
        'Paste shape into slide.
        ppSlide.Shapes.Paste


        'Create a reference to the shape we want to manipulate.
        Set ppShape = ppSlide.Shapes(.Shapes.Count)
 
        'Set properties for shape
        With ppShape
          .Left = LeftArray(x)
          .Top = TopArray(x)
          .Height = HeightArray(x)
          .Width = WidthArray(x)
        End With
    
        'Add a new slide and set a reference to it.
        Set ppSlide = ppPres.Slides.Add(ppPres.Slides.Count + 1, 12) 'ppLayoutBlank
        
        'Change Slide Color to a blue background.
        With ppSlide
            .FollowMasterBackground = msoFalse
            .Background.Fill.Solid
            .Background.Fill.ForeColor.RGB = RGB(0, 45, 155)
        End With


    Next x
    
'Clear from memory
Set ppApp = Nothing
Set ppPres = Nothing
Set ppSlide = Nothing




End Sub