VBA: Copy plots from excel to PowerPoint

grubarbarian

New Member
Joined
Jun 29, 2016
Messages
11
Dear Wizards,

I have the following script that works great for going through a multi-worksheet excel file and copying and pasting the plots onto a new slide in PowerPoint. My problem is that some worksheets have 2 or more charts on them and I would like to develop the code below so that when there are more than one chart per worksheet that these charts to be displayed on one single PowerPoint slide (ie) 2 or more charts per single slide, whilst maintaining the feature that the other worksheets that have only 1 chart are still plotted on a singe slide.

Many thanks in advance,

Sub ExportChartsToPowerPoint_SingleWorkbook()
'declare PowerPoint Variables
Dim PPTApp As PowerPoint.Application
Dim PPTPres As PowerPoint.Presentation
Dim PPTSlide As PowerPoint.Slide
Dim SldIndex As Integer


'declare an Excel Object Variables
Dim Chrt As ChartObject
Dim WrkSht As Worksheet

'Create a new instance of PowerPoint
Set PPTApp = New PowerPoint.Application
PPTApp.Visible = True

'Create a new Presentation within the application
Set PPTPres = PPTApp.Presentations.Add

'CREATE AN INDEX HANDLER FOR SLIDE CREATION
SldIndex = 1

'Loop through all of the worksheet in the ACTIVE workbook
For Each WrkSht In Worksheets

'Loop through all the chart objects on the ACTIVE sheet
For Each Chrt In WrkSht.ChartObjects

'Copy the chart
Chrt.Copy

'Create a new slide, set the layout to blank, and paste the chart on the slide
Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
PPTSlide.Shapes.Paste

'Increment our slide index
SldIndex = SldIndex + 1

Next Chrt

Next WrkSht


End Sub
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,722
In future, please post your code within code tags so that it's easier to read. Having said that, I have amended your code as follows. Note that you'll need to make changes to suit your needs. In particular, you'll need to change the starting left and top positions for each slide, along with the desired gap between charts.

VBA Code:
Sub ExportChartsToPowerPoint_SingleWorkbook()

 
    'declare constants for the starting left and top positions for each slide,
    'along with the gap between charts (change as desired)
    Const StartLeftPos As Single = 50
    Const StartTopPos As Single = 50
    Const Gap As Long = 30

    'declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldIndex As Integer


    'declare an Excel Object Variables
    Dim Chrt As ChartObject
    Dim WrkSht As Worksheet
    Dim ChrtIndex As Long
    Dim CurrentLeftPos As Single
    Dim CurrentTopPos As Single

    'Create a new instance of PowerPoint
    Set PPTApp = New PowerPoint.Application
    PPTApp.Visible = True

    'Create a new Presentation within the application
    Set PPTPres = PPTApp.Presentations.Add

    'CREATE AN INDEX HANDLER FOR SLIDE CREATION
    SldIndex = 1

    'Loop through all of the worksheet in the ACTIVE workbook
    For Each WrkSht In Worksheets

        'Create a new slide, set the layout to blank
        Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
    
        'Index handler for chart
        ChrtIndex = 1
    
        'Starting left position for slide
        CurrentLeftPos = StartLeftPos
    
        'Starting top position for slide
        CurrentTopPos = StartTopPos
    
        'Loop through all the chart objects on the ACTIVE sheet
        For Each Chrt In WrkSht.ChartObjects
    
            'Copy the chart
            Chrt.Copy
        
            'Paste the chart on the slide
            Set PPTShape = PPTSlide.Shapes.Paste(1)

            'Position newly pasted chart on the slide
            If (ChrtIndex Mod 2) = 1 Then
                With PPTShape
                    .Left = CurrentLeftPos
                    .Top = CurrentTopPos
                    CurrentLeftPos = CurrentLeftPos + .Width + Gap
                End With
            Else
                With PPTShape
                    .Left = CurrentLeftPos
                    .Top = CurrentTopPos
                    CurrentLeftPos = StartLeftPos
                    CurrentTopPos = CurrentTopPos + .Height + Gap
                End With
            End If
        
            ChrtIndex = ChrtIndex + 1
    
        Next Chrt

        'Increment our slide index
        SldIndex = SldIndex + 1
    
    Next WrkSht

End Sub

Hope this helps!
 
Last edited:

grubarbarian

New Member
Joined
Jun 29, 2016
Messages
11
Thank you so much. Please, if I can bother you one more time, can you show me how to :
1) paste the plots as pictures rather than "live" plots
2) show me how to change the format so that when there are two plots per slide that the plots are stacked on top of each other.

Many thanks!!
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,722
You're very welcome, glad I could help. As per your request, I have amended the macro to copy charts as a picture, and to stack each one below the other...

VBA Code:
Sub ExportChartsToPowerPoint_SingleWorkbook()

    'declare constants
    Const LeftPos As Single = 50
    Const TopPos As Single = 50
    Const Gap As Long = 30

    'declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldIndex As Integer
    
    
    'declare an Excel Object Variables
    Dim Chrt As ChartObject
    Dim WrkSht As Worksheet
    Dim CurrentTopPos As Single
    
    'Create a new instance of PowerPoint
    Set PPTApp = New PowerPoint.Application
    PPTApp.Visible = True
    
    'Create a new Presentation within the application
    Set PPTPres = PPTApp.Presentations.Add
    
    'CREATE AN INDEX HANDLER FOR SLIDE CREATION
    SldIndex = 1
    
    'Loop through all of the worksheet in the ACTIVE workbook
    For Each WrkSht In Worksheets
    
        'Create a new slide, set the layout to blank
        Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
        
        'Starting top position for slide
        CurrentTopPos = TopPos
        
        'Loop through all the chart objects on the ACTIVE sheet
        For Each Chrt In WrkSht.ChartObjects
        
            'Copy the chart
            Chrt.Chart.CopyPicture
            
            'Paste the chart on the slide
            Set PPTShape = PPTSlide.Shapes.Paste(1)

            'Position newly pasted chart on the slide
            With PPTShape
                .Left = LeftPos
                .Top = CurrentTopPos
                CurrentTopPos = CurrentTopPos + .Height + Gap
            End With
            
        Next Chrt
    
        'Increment our slide index
        SldIndex = SldIndex + 1
        
    Next WrkSht

End Sub
 

grubarbarian

New Member
Joined
Jun 29, 2016
Messages
11
Tremendous!! Thank you so much. I'll mess around with your amazing code to try to re-size the plots, but you've done all of the hard part!
 

Forum statistics

Threads
1,141,406
Messages
5,706,268
Members
421,437
Latest member
GijoeBlack

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top