# VBA code to copy data into powerpoint 2010 chart from excel 2010?



## josephjcota

VBA code to copy data into powerpoint 2010 chart from excel 2010?
I am trying to automate the process of populating the charts in the  powerpoint (office 2010). Can anybody please help with the VBA code to 

Copy data in excel > select the template chart in the powerpoint >  open the data sheet > paste the copied data and close>loop

I am using office 2010, so please provide codes that work in office 2010. 

I initially tried to create charts in excel and paste it in the  powerpoint with the link and update the link whenever we get new data.  However, after pasting couple of charts it becomes very slow. Since I  have more than 200 charts, updating all the charts using VBA is my only  option.


----------



## Derek Brown

Hello and welcome to The Board.
Not exactly what you were asking for but you should be able to make use of it.
*Important: Always test on a copy of the workbook(s).*
The following code will copy Excel Charts to PowerPoint.
It was originally written for Excel 2003 but a quick test indicates that it may be OK for Excel 2010.
Applying a template to a new existing presentation was diffrerent in Office 2003 but you may find that the following will help you: 
http://www.dummies.com/how-to/conte...nt-2007-template-to-an-exis.navId-405688.html


		Code:
__


Option Explicit
Sub CopyChartsToPowerPoint()
'
'Excel Application objects declaration
Dim ws As Worksheet
Dim objChartObject As ChartObject
Dim objChart As Chart
Dim objCht As Chart
Dim lngSlideKount As Long
'
'Powerpoint Application objects declaration
' You need to add a reference (Tools | References) to the Microsoft PowerPoint nn.nn Object Library
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
'
On Error GoTo Error_Para
'
    'Create a new Powerpoint session
    Set pptApp = CreateObject("PowerPoint.Application")
    '
    pptApp.Visible = msoTrue
    'Create a new presentation
    Set pptPres = pptApp.Presentations.Add
    Set pptPres = pptApp.ActivePresentation
    '
    pptApp.ActiveWindow.ViewType = ppViewSlide
'
    lngSlideKount = 0
    For Each ws In ActiveWorkbook.Worksheets
      'Verify if there is a chart object to transfer
      If ws.ChartObjects.Count > 0 Then
        For Each objChartObject In ws.ChartObjects
          Set objChart = objChartObject.Chart
          'ppLayoutBlank = 12
          Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
          pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
          With objChart
           'Copy chart object as picture
            objChart.CopyPicture xlScreen, xlBitmap, xlScreen
            'Paste copied chart picture into new slide
            pptSld.Shapes.Paste.Select
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
          End With
          lngSlideKount = lngSlideKount + 1
        Next objChartObject
      End If
    Next ws
    ' Now check CHART sheets:
    For Each objCht In ActiveWorkbook.Charts
        'ppLayoutBlank = 12
        Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
        pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
        With objCht
            'Copy chart object as picture
            .CopyPicture xlScreen, xlBitmap, xlScreen
            'Paste copied chart picture into new slide
            pptSld.Shapes.Paste.Select
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
        End With
        lngSlideKount = lngSlideKount + 1
    Next objCht
    '
    'Activate PowerPoint application
    pptApp.ActiveWindow.ViewType = ppViewNormal
    pptApp.Visible = True
    pptApp.Activate
    If lngSlideKount > 0 Then
        If lngSlideKount = 1 Then
            MsgBox "1 chart was copied to PowerPoint", vbOKOnly + vbInformation, "Information"
        Else
            MsgBox lngSlideKount & " charts were copied to PowerPoint", vbOKOnly + vbInformation, "Information"
        End If
    End If
    GoTo Exit_Para
Error_Para:
    MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & _
        Err.Description & vbCrLf & vbCrLf & _
        "copying charts to PowerPoint", vbOKOnly + vbCritical, "Error"
Exit_Para:
    On Error Resume Next
    Set ws = Nothing
    Set objChart = Nothing
    Set objChartObject = Nothing
    Set pptSld = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub


----------



## Derek Brown

I have been asked to provide a code change to 'link' the excel charts to PowerPoint instead of coping the charts as pictures.
Here is the code to replace the "similar" section of code previously given:


		Code:
__


    lngSlideKount = 0
    For Each ws In ActiveWorkbook.Worksheets
      'Verify if there is a chart object to transfer
      If ws.ChartObjects.Count > 0 Then
        For Each objChartObject In ws.ChartObjects
          Set objChart = objChartObject.Chart
          'ppLayoutBlank = 12
          Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
          pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
          With objChart
            '
            objChart.ChartArea.Copy '<=====
            pptSld.Shapes.PasteSpecial(Link:=msoCTrue).Select  ' <=====
            '
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
          End With
          lngSlideKount = lngSlideKount + 1
        Next objChartObject
      End If
    Next ws
    ' Now check CHART sheets:
    For Each objCht In ActiveWorkbook.Charts
        'ppLayoutBlank = 12
        Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
        pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
        With objCht
            '
            .ChartArea.Copy ' <=====
            pptSld.Shapes.PasteSpecial(Link:=msoCTrue).Select  ' <=====
            '
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
        End With
        lngSlideKount = lngSlideKount + 1
    Next objCht

The changed lines are highlighted with "<=====".

This seems to work OK for me using Office 2010 but note that it has *not* been extensively tested.


----------



## ADELAF

Hi there! Thank you for your help! It is exactly what I needed! 

Anne


----------



## Derek Brown

That's OK, Anne - pleased it works OK for you.
Until I received your PM, I had not had a need to link (only paste) pictures so I may even find it useful myself in the future.


----------



## nmoiseff

This is absolutely fantastic! I have been trying to find code similiar to this for a long time. 

Is there a way to modify this code so that it copies a range of cells in each worksheet instead of just the chart objects? 

I ask this because I want to copy and paste both a chart and a table (right below the chart) and paste it into powerpoint. The range of cells that includes both the chart and the table would be J1:Y35.


----------



## Derek Brown

Hello and welcome to The Board.
Here is an example of what you want to do - you will need to change the name of the worksheet and the range of cells that you want to copy to PowerPoint.
It works for me using Office 2010.


		Code:
__


Sub CopyChartsToPowerPoint3()
'
'Excel Application objects declaration
Dim ws As Worksheet
Dim objChartObject As ChartObject
Dim objChart As Chart
Dim objCht As Chart
Dim lngSlideKount As Long
'
'Powerpoint Application objects declaration
' You need to add a reference (Tools | References) to the Microsoft PowerPoint nn.nn Object Library
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
'
On Error GoTo Error_Para
'
    'Create a new Powerpoint session
    Set pptApp = CreateObject("PowerPoint.Application")
    '
    pptApp.Visible = msoTrue
    'Create a new presentation
    Set pptPres = pptApp.Presentations.Add
    Set pptPres = pptApp.ActivePresentation
    '
    pptApp.ActiveWindow.ViewType = ppViewSlide
'
    lngSlideKount = 0
    'ppLayoutBlank = 12
    Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
    pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
' ======================================================================
' Changed code in this Message Board post:
' This code needs to be tidied
' e.g. Dim wb as Workbook
' Set wb = ThisWorkbook
' Set ws = wb.Worksheets("MySheet")
' etc.
' ======================================================================
' select sheet containing data to be copied to PowerPoint:
    Sheets("MySheet").Select
' select cells to be copied to PowerPoint:
    Range("A1:I24").Select
' copy cells:
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' past to PowerPoint:
    pptSld.Shapes.Paste.Select
    lngSlideKount = lngSlideKount + 1
' END OF CHANGED CODE
' ======================================================================
'
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    '
    'Activate PowerPoint application
    pptApp.ActiveWindow.ViewType = ppViewNormal
    pptApp.Visible = True
    pptApp.Activate
    If lngSlideKount > 0 Then
        If lngSlideKount = 1 Then
            MsgBox "1 chart was copied to PowerPoint", vbOKOnly + vbInformation, "Information"
        Else
            MsgBox lngSlideKount & " charts were copied to PowerPoint", vbOKOnly + vbInformation, "Information"
        End If
    End If
    GoTo Exit_Para
Error_Para:
    MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & _
        Err.Description & vbCrLf & vbCrLf & _
        "copying charts to PowerPoint", vbOKOnly + vbCritical, "Error"
Exit_Para:
    On Error Resume Next
    Set ws = Nothing
    Set objChart = Nothing
    Set objChartObject = Nothing
    Set pptSld = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub


----------



## nmoiseff

Derek, 

Thank you very much for the quick response. This code helps but it does not loop through each worksheet in the workbook, nor does it add a slide for each worksheet. I have modified your code some so that it adds a new powerpoint slide, but it still does not copy content from each worksheet and paste it to the slide. Instead it copies a cell range from the active worksheet and pastes that same content to a new slide. 

For example, I have 18 worksheets in my workbook. Right now the code copies cell range I1:Y35 from the activeworksheet 18 times and puts it on 18 different powerpoint slides. Ideally I would like cell range I1:Y35 from worksheet1 -> PowerPoint Slide #1, cell range I1:Y35 from worksheet2 -> PowerPoint Slide #2, cell range I1:Y35 from worksheet3 -> PowerPoint Slide #3, etc. 

How would I loop it so that it performs the copy function on each worksheet? I thought it was the 'For Each ws in Activeworkbook.worksheets' command, but this doesnt seem to do the trick. Your code (that I modified) is below. 

Again, thank you very much for the help.


Sub CopyChartsToPowerPoint3()
'
'Excel Application objects declaration
Dim ws As Worksheet
Dim objChartObject As ChartObject
Dim objChart As Chart
Dim objCht As Chart
Dim lngSlideKount As Long
'
'Powerpoint Application objects declaration
' You need to add a reference (Tools | References) to the Microsoft PowerPoint nn.nn Object Library
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
'
On Error GoTo Error_Para
'
    'Create a new Powerpoint session
    Set pptApp = CreateObject("PowerPoint.Application")
    '
    pptApp.Visible = msoTrue
    'Create a new presentation
    Set pptPres = pptApp.Presentations.Add
    Set pptPres = pptApp.ActivePresentation
    '
    pptApp.ActiveWindow.ViewType = ppViewSlide
'
    lngSlideKount = 0
    'ppLayoutBlank = 12
    Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
    pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
' ======================================================================
' Changed code in this Message Board post:
' This code needs to be tidied
' e.g. Dim wb as Workbook
' Set wb = ThisWorkbook
' Set ws = wb.Worksheets("MySheet")
' etc.
' ======================================================================
' select sheet containing data to be copied to PowerPoint:
    For Each ws In ActiveWorkbook.Worksheets
' select cells to be copied to PowerPoint:
    Range("I1:Y35").Select
' copy cells:
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' past to PowerPoint:
    pptSld.Shapes.Paste.Select
    Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
    pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
    Next ws
' END OF CHANGED CODE
' ======================================================================
'
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    '
    'Activate PowerPoint application
    pptApp.ActiveWindow.ViewType = ppViewNormal
    pptApp.Visible = True
    pptApp.Activate
    If lngSlideKount > 0 Then
        If lngSlideKount = 1 Then
            MsgBox "1 chart was copied to PowerPoint", vbOKOnly + vbInformation, "Information"
        Else
            MsgBox lngSlideKount & " charts were copied to PowerPoint", vbOKOnly + vbInformation, "Information"
        End If
    End If
    GoTo Exit_Para
Error_Para:
    MsgBox "Error " & Err.Number & vbCrLf & vbCrLf & _
        Err.Description & vbCrLf & vbCrLf & _
        "copying charts to PowerPoint", vbOKOnly + vbCritical, "Error"
Exit_Para:
    On Error Resume Next
    Set ws = Nothing
    Set objChart = Nothing
    Set objChartObject = Nothing
    Set pptSld = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub


----------



## Derek Brown

I just gave a simple example that you could build upon - it is one thing copying ALL charts but when it comes to worksheets, it is very likely that you would not want all of them.
Try the following changes to the code:


		Code:
__


    lngSlideKount = 0
For Each ws In ActiveWorkbook.Worksheets
    'ppLayoutBlank = 12
    Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
    pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
' ======================================================================
' Changed code in this Message Board post:
' This code needs to be tidied
' e.g. Dim wb as Workbook
' Set wb = ThisWorkbook
' Set ws = wb.Worksheets("MySheet")
' etc.
' ======================================================================
' select sheet containing data to be copied to PowerPoint:
    'Sheets("MySheet").Select
    ws.Select
' select cells to be copied to PowerPoint:
    'Range("A1:I24").Select
    ws.Range("I1:Y35").Select
' copy cells:
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' past to PowerPoint:
    pptSld.Shapes.Paste.Select
    lngSlideKount = lngSlideKount + 1
' END OF CHANGED CODE
' ======================================================================

    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'
Next ws
'
'Activate PowerPoint application

If you later find that you do not want ALL worksheets then the solution is to list those that you do want, in a table and give the column a (range) name.Then change the code to get the names within the loop and select each of those sheets in turn.


----------



## nmoiseff

I modified the code that you suggested but I receive an error when I attempt to run the Macro; Error 1004 Method 'Select' of object '_Worksheet' failed. 

The code that I copied in is the following; 

     lngSlideKount = 0
For Each ws In ActiveWorkbook.Worksheets
    'ppLayoutBlank = 12
    Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
    pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
' ======================================================================
' Changed code in this Message Board post:
' This code needs to be tidied
' e.g. Dim wb as Workbook
' Set wb = ThisWorkbook
' Set ws = wb.Worksheets("MySheet")
' etc.
' ======================================================================
' select sheet containing data to be copied to PowerPoint:
    'Sheets("MySheet").Select
    ws.Select
' select cells to be copied to PowerPoint:
    'Range("A1:I24").Select
    ws.Range("I1:Y35").Select
' copy cells:
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' past to PowerPoint:
    pptSld.Shapes.Paste.Select
    lngSlideKount = lngSlideKount + 1
' END OF CHANGED CODE
' ======================================================================

    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'
Next ws

Is it the "ws.Select" command that is throwing this error? I tried to modify it to ActiveWorkbook.ws.select but this does not work either. Any ideas?


----------



## josephjcota

VBA code to copy data into powerpoint 2010 chart from excel 2010?
I am trying to automate the process of populating the charts in the  powerpoint (office 2010). Can anybody please help with the VBA code to 

Copy data in excel > select the template chart in the powerpoint >  open the data sheet > paste the copied data and close>loop

I am using office 2010, so please provide codes that work in office 2010. 

I initially tried to create charts in excel and paste it in the  powerpoint with the link and update the link whenever we get new data.  However, after pasting couple of charts it becomes very slow. Since I  have more than 200 charts, updating all the charts using VBA is my only  option.


----------



## nmoiseff

Disregard. I was able to figure it out. Updated code below. Thank you very much again for your help. 


 lngSlideKount = 0
For Each ws In ActiveWorkbook.Worksheets
    'ppLayoutBlank = 12
    Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
    pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
' ======================================================================
' Changed code in this Message Board post:
' This code needs to be tidied
' e.g. Dim wb as Workbook
' Set wb = ThisWorkbook
' Set ws = wb.Worksheets("MySheet")
' etc.
' ======================================================================
' select sheet containing data to be copied to PowerPoint:
    'Sheets("MySheet").Select
    ws.Activate '<==========================================
' select cells to be copied to PowerPoint:
    'Range("A1:I24").Select
    Range("I1:Y35").Select

' copy cells:
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
' past to PowerPoint:
    pptSld.Shapes.Paste.Select
    lngSlideKount = lngSlideKount + 1
' END OF CHANGED CODE
' ======================================================================

    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'
Next ws


----------



## Derek Brown

Well done. I was in the process of replying to suggest making that change although the code worked for me with the 'select'.


----------



## ffialho

Hi all! I've been using this code! It's great! Just need to know how I can referente to open a specific PPT instead of creating a new instance. And How can I resize the picture in PPT?! can you put out an example so I can complete my magic here. thanks


----------



## jjbungles

_ Hello,_

_I have done a macro, based in excel 2003 that does what i think you want._


_It's here:_

_http://www.mrexcel.com/forum/showthread.php?p=2933602#post2933602 
_

_JJ
_


----------



## hitesh.relhan

Derek Brown said:


> I have been asked to provide a code change to 'link' the excel charts to PowerPoint instead of coping the charts as pictures.
> Here is the code to replace the "similar" section of code previously given:
> 
> 
> Code:
> __
> 
> 
> lngSlideKount = 0
> For Each ws In ActiveWorkbook.Worksheets
> 'Verify if there is a chart object to transfer
> If ws.ChartObjects.Count > 0 Then
> For Each objChartObject In ws.ChartObjects
> Set objChart = objChartObject.Chart
> 'ppLayoutBlank = 12
> Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
> pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
> With objChart
> '
> objChart.ChartArea.Copy '<=====
> pptSld.Shapes.PasteSpecial(Link:=msoCTrue).Select  ' <=====
> '
> pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
> pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
> End With
> lngSlideKount = lngSlideKount + 1
> Next objChartObject
> End If
> Next ws
> ' Now check CHART sheets:
> For Each objCht In ActiveWorkbook.Charts
> 'ppLayoutBlank = 12
> Set pptSld = pptPres.Slides.Add(lngSlideKount + 1, 12)
> pptApp.ActiveWindow.View.GotoSlide pptSld.SlideIndex
> With objCht
> '
> .ChartArea.Copy ' <=====
> pptSld.Shapes.PasteSpecial(Link:=msoCTrue).Select  ' <=====
> '
> pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
> pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
> End With
> lngSlideKount = lngSlideKount + 1
> Next objCht
> 
> The changed lines are highlighted with "<=====".
> 
> This seems to work OK for me using Office 2010 but note that it has *not* been extensively tested.




Hi Derek

I tried using this code. But I got an error due to the line 

' You need to add a reference (Tools | References) to the Microsoft PowerPoint nn.nn Object Library Dim pptApp As PowerPoint.Application


Please let me know how can we solve this error. 
I am a novice in vba. Help would be highly appreciated.


----------



## Joe4

> I tried using this code. But I got an error due to the line
> 
> ' You need to add a reference (Tools | References) to the Microsoft PowerPoint nn.nn Object Library Dim pptApp As PowerPoint.Application
> 
> 
> Please let me know how can we solve this error.
> I am a novice in vba. Help would be highly appreciated.


The code uses Microsoft PowerPoint objects, so you need to select that object library in order to use it.

Just go into your VB Editor, and from the Tools menu, select References.  Then browse down the list under you find one that begins with "Microsoft PowerPoint ...", select it (check-box), and click OK.


----------



## JPCMcAllen

Derek, thanks for the code it works great but I'm fighting to have the correct template applied to each slide created with the code above and now several years later the link you posted is not working.  Do you or does anyone have some code they would share?

Using Office Professional 2010 I'd like to have a Template applied to each slide created and a 2nd bonus would hint at copying each existing Pivot table to a slide in the same manner as the charts, pasting as an image.  Thanks in advance to all.  GREAT forum.  GREAT resource.


----------



## meghbal

I have 200 excel cells a1-a200

I need to creat 200 power point slides can you help me.

My excell File is "Morry"

and the power point is   "Lesson1"

Please, give me simple instructions.
*it is all text.*


----------



## JPCMcAllen

I'm still trying to find a way to apply a specific Power Point Template in this process/Routine that runs from Excel.  Any help would be appreciated.  Thanks


----------



## meghbal

I was not able to do it.


----------



## josephjcota

VBA code to copy data into powerpoint 2010 chart from excel 2010?
I am trying to automate the process of populating the charts in the  powerpoint (office 2010). Can anybody please help with the VBA code to 

Copy data in excel > select the template chart in the powerpoint >  open the data sheet > paste the copied data and close>loop

I am using office 2010, so please provide codes that work in office 2010. 

I initially tried to create charts in excel and paste it in the  powerpoint with the link and update the link whenever we get new data.  However, after pasting couple of charts it becomes very slow. Since I  have more than 200 charts, updating all the charts using VBA is my only  option.


----------



## TG2812

Sorry guys for starting up that conversation again but i'm a beginner and trying to sort of adapt the codes given above. But it doesn't work and i don't know why. Any inputs is more than welcome =)
here's the code:

----------------------------------------------------
Sub PWP()

Application.ScreenUpdating = False
Application.DisplayAlerts = False


Dim newPP As PowerPoint.Application
Set newPP = CreateObject("PowerPoint.Application")
Dim newPres As PowerPoint.Presentation
Set newPres = newPP.Presentations.Add
Set newPres = newPP.ActivePresentation
Dim slide As PowerPoint.slide
Dim chart As Excel.chart
Dim slide_counter As Long




newPP.Visible = True
newPP.ActiveWindow.ViewType = ppViewSlide


slide_counter = 0
For Each chart In ActiveWorkbook.Sheets("Dashboard").ChartObjects
    Set slide = newPres.Slides.Add(slide_counter + 1, 12)
    newPP.ActiveWindow.View.GotoSlide slide.SlideIndex

    With chart
    objchart.ChartArea.Copy
    slide.Shapes.PasteSpecial(link = msoCTrue).Select

    newPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    newPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    End With

    slide_counter = slide_counter + 1
Next


Set chart = Nothing
Set slide = Nothing
Set newPres = Nothing
Set newPP = Nothing


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub


----------



## jjbungles

TG2812 said:


> Sorry guys for starting up that conversation again but i'm a beginner and trying to sort of adapt the codes given above. But it doesn't work and i don't know why. Any inputs is more than welcome =)
> here's the code:
> 
> ----------------------------------------------------
> Sub PWP()
> 
> Application.ScreenUpdating = False
> Application.DisplayAlerts = False
> 
> 
> Dim newPP As PowerPoint.Application
> Set newPP = CreateObject("PowerPoint.Application")
> Dim newPres As PowerPoint.Presentation
> Set newPres = newPP.Presentations.Add
> Set newPres = newPP.ActivePresentation
> Dim slide As PowerPoint.slide
> Dim chart As Excel.chart
> Dim slide_counter As Long
> 
> 
> 
> 
> newPP.Visible = True
> newPP.ActiveWindow.ViewType = ppViewSlide
> 
> 
> slide_counter = 0
> For Each chart In ActiveWorkbook.Sheets("Dashboard").ChartObjects
> Set slide = newPres.Slides.Add(slide_counter + 1, 12)
> newPP.ActiveWindow.View.GotoSlide slide.SlideIndex
> 
> With chart
> objchart.ChartArea.Copy
> slide.Shapes.PasteSpecial(link = msoCTrue).Select
> 
> newPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
> newPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
> End With
> 
> slide_counter = slide_counter + 1
> Next
> 
> 
> Set chart = Nothing
> Set slide = Nothing
> Set newPres = Nothing
> Set newPP = Nothing
> 
> 
> Application.ScreenUpdating = True
> Application.DisplayAlerts = True
> 
> 
> End Sub



what error are you getting?


----------



## TG2812

I get a "type mismatch error" right after the loop initializes...


----------



## Worf

TG2812 said:


> I get a "type mismatch error" right after the loop initializes...



On exactly what line?


----------



## jjbungles

OK try this....



		Code:
__


Option Explicit
Sub PWP()

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False


 Dim newPP As PowerPoint.Application
 Set newPP = CreateObject("PowerPoint.Application")
 Dim newPres As PowerPoint.Presentation
 Set newPres = newPP.Presentations.Add
 Set newPres = newPP.ActivePresentation
 Dim slide As PowerPoint.slide
 Dim chart As Object
 Dim slide_counter As Long




 newPP.Visible = True
 newPP.ActiveWindow.ViewType = ppViewSlide


 slide_counter = 0
  For Each chart In ActiveWorkbook.Sheets("Dashboard").ChartObjects
 Set slide = newPres.Slides.Add(slide_counter + 1, 12)
 newPP.ActiveWindow.View.GotoSlide slide.SlideIndex

 With chart
 chart.CopyPicture Appearance:=xlScreen, _
        Format:=xlPicture
 'chart.ChartArea.Copy
 slide.Shapes.Paste.Select

 newPP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
 newPP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
 End With

 slide_counter = slide_counter + 1
 Next


 Set chart = Nothing
 Set slide = Nothing
 Set newPres = Nothing
 Set newPP = Nothing


 Application.ScreenUpdating = True
 Application.DisplayAlerts = True


 End Sub


----------



## TG2812

Thanks for your prompt replies guys but i found where the mistake is located =)). Thanks again


----------

