The previous week a friend of mine asked me for a favor. He told me that he spends a lot of time copying Excel charts (as pictures) to Power Point presentations. The problem was that he had some really large workbooks that contained experimental results. Each workbook had more than 20 charts, so the procedure of “copy – paste special” was really time-consuming (and boring). He wanted from each workbook to create a new presentation and in every slide to include a text box with the chart title and the chart itself as picture.
My solution to his problem was the code that you will find below. The code loops in every sheet and tries to find embedded charts. Afterwards, it loops in chart sheets. Whenever a chart is found, is copied and is inserted as a picture to a new power point slide.
VBA code
Option Explicit
'Both subs require a reference to Microsoft PowerPoint xx.x Object Library.
'where xx.x is your office version (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010).
'Declaring the necessary Power Point variables (are used in both subs).
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Sub ChartsToPowerPoint()
'Exports all the chart sheets to a new power point presentation.
'It also adds a text box with the chart title.
'By Christos Samaras
'https://myengineeringworld.net/////
Dim ws As Worksheet
Dim intChNum As Integer
Dim objCh As Object
'Count the embedded charts.
For Each ws In ActiveWorkbook.Worksheets
intChNum = intChNum+ ws.ChartObjects.Count
Next ws
'Check if there are chart (embedded or not) in the active workbook.
If intChNum + ActiveWorkbook.Charts.Count < 1 Then
MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
Exit Sub
End If
'Open PowerPoint and create a new presentation.
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Add
'Loop through all the embedded charts in all worksheets.
For Each ws In ActiveWorkbook.Worksheets
For Each objCh In ws.ChartObjects
Call pptFormat(objCh.Chart)
Next objCh
Next ws
'Loop through all the chart sheets.
For Each objCh In ActiveWorkbook.Charts
Call pptFormat(objCh)
Next objCh
'Show the power point.
pptApp.Visible = True
'Cleanup the objects.
Set pptSlide = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
'Infrom the user that the macro finished.
MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "Done"
End Sub
Private Sub pptFormat(xlCh As Chart)
'Formats the charts/pictures and the chart titles/textboxes.
'By Christos Samaras
'https://myengineeringworld.net/////
Dim chTitle As String
Dim j As Integer
On Error Resume Next
'Get the chart title and copy the chart area.
chTitle = xlCh.ChartTitle.Text
xlCh.ChartArea.Copy
'Count the slides and add a new one after the last slide.
pptSlideCount = pptPres.Slides.Count
Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
'Paste the chart and create a new textbox.
pptSlide.Shapes.PasteSpecial ppPasteJPG
If chTitle <> "" Then
pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
End If
'Format the picture and the textbox.
For j = 1 To pptSlide.Shapes.Count
With pptSlide.Shapes(j)
'Picture position.
If .Type = msoPicture Then
.Top = 87.84976
.Left = 33.98417
.Height = 422.7964
.Width = 646.5262
End If
'Text box position and formamt.
If .Type = msoTextBox Then
With .TextFrame.TextRange
.ParagraphFormat.Alignment = ppAlignCenter
.Text = chTitle
.Font.Name = "Tahoma (Headings)"
.Font.Size = 28
.Font.Bold = msoTrue
End With
End If
End With
Next j
End Sub
How to use it
The short video below demonstrates the VBA code in use.
Download it from here
The zip file contains three files, one for each office version (2003, 2007 & 2010). Each file has already a reference to the corresponding Power Point library. Just remember to enable macros before using them.
Read also
Export Excel Ranges As Power Point Tables
Resize Pictures During A Presentation
Marcus, thank you very much for your kind words.
If your problem was solved, then everything is fine.
Kind Regards,
Christos
Hey Christos,
Thank you so much for taking the time to create this code. It worked just as I suspected it would! The issue I had was, i was not passing a number to shapes.
The more I look through your site the more I am learning. Its like a treasure trove of information!
Thank you again,
Marcus
Hello my friend and thank you for your kind comment. Please see the VBA code below which uses a specific image as header to each slide. Please change it according to your needs. I have tested it and it works.
Kind Regards,
Christos
Option Explicit
'Both subs require a reference to Microsoft PowerPoint xx.x Object Library.
'where xx.x is your office version (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010).
'Declaring the necessary Power Point variables (are used in both subs).
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Sub ChartsToPowerPoint()
'Exports all the chart sheets to a new power point presentation.
'It also adds a text box with the chart title.
'By Christos Samaras
'https://myengineeringworld.net/////
Dim ws As Worksheet
Dim intChNum As Integer
Dim objCh As Object
'Count the embedded charts.
For Each ws In ActiveWorkbook.Worksheets
intChNum = ws.ChartObjects.Count
Next ws
'Check if there are chart (embedded or not) in the active workbook.
If intChNum + ActiveWorkbook.Charts.Count < 1 Then
MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
Exit Sub
End If
'Open PowerPoint and create a new presentation.
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Add
'Loop through all the embedded charts in all worksheets.
For Each ws In ActiveWorkbook.Worksheets
For Each objCh In ws.ChartObjects
Call pptFormat2(objCh.Chart, Sheet1.Shapes(2))
Next objCh
Next ws
'Loop through all the chart sheets.
For Each objCh In ActiveWorkbook.Charts
Call pptFormat2(objCh, Sheet1.Shapes(2))
Next objCh
'Show the power point.
pptApp.Visible = True
'Cleanup the objects.
Set pptSlide = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
'Infrom the user that the macro finished.
MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "Done"
End Sub
Private Sub pptFormat2(xlCh As Chart, xlImg As Shape)
'Formats the chart picture and the header picture.
'By Christos Samaras
'https://myengineeringworld.net/////
Dim chTitle As String
On Error Resume Next
'Copy the chart area.
xlCh.ChartArea.Copy
'Count the slides and add a new one after the last slide.
pptSlideCount = pptPres.Slides.Count
Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
'Paste the chart as well as the header image.
pptSlide.Shapes.PasteSpecial ppPasteJPG
xlImg.Copy
pptSlide.Shapes.PasteSpecial ppPasteJPG
'Format the chart picture.
With pptSlide.Shapes(1)
If .Type = msoPicture Then
.Top = 87.84976
.Left = 33.98417
.Height = 422.7964
.Width = 646.5262
End If
End With
'Format the header picture.
With pptSlide.Shapes(2)
If .Type = msoPicture Then
.Top = 12.5
.Left = 33.98417
.Height = 55.25
.Width = 646.5262
End If
End With
End Sub
Hi Christos,
I was hoping you could assist me with my issue. Your coding was a real big help for me figuring out my mistakes.
Now I am trying to build upon my code even more. What I am trying to do is not only export charts, but I would like to export an image.jpg I am using in excel as a header/title of sorts for each worksheet. Then paste it into PowerPoint at the top above the charts to add "flavor" to the PowerPoint.
So far I have been able to select and copy the image from excel. However upon paste into PowerPoint it errors out after the first slide. I have tried using a different image on each excel worksheet to see if that would be easier to no avail either.
Thank you again for the help your coding has provided!
Thank you very much for your kind comment. For anyone who is interested in exporting only the embedded charts of the active sheet, please check the code below:
Sub ActiveSheetChartsToPowerPoint()
'Exports the embedded charts of the active worksheet to a new power point presentation.
'It also adds a text box with the chart title.
'By Christos Samaras
'https://myengineeringworld.net/////
Dim ws As Worksheet
Dim intChNum As Integer
Dim objCh As Object
'Check if there are embedded charts in the active worksheeet.
If ActiveSheet.ChartObjects.Count < 1 Then
MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
Exit Sub
End If
'Open PowerPoint and create a new presentation.
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Add
'Loop through all the embedded charts in the active sheet.
For Each objCh In ActiveSheet.ChartObjects
Call pptFormat(objCh.Chart)
Next objCh
'Show the power point.
pptApp.Visible = True
'Cleanup the objects.
Set pptSlide = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
'Infrom the user that the macro finished.
MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "Done"
End Sub
Note that the pptFormat macro is the same as above…
Kind Regards,
Christos
Thank you Christos,
This works like a charm. I was having issues on my coding where it would only pull charts from the active sheet.
Keep up the good work!