Excel to PowerPoint Charts VBA

I am working on a project which I need to import several charts, table and range in several excel sheet within a workbook INTO several powerpoint slides.


Also I need to resize the charts in the powerppoint slide.


I wrote a macro for a bit part of the project which works perfectly, but I felt the code will be too long  because I have more than 100 charts and tables

I need to import to the powerpoint. Below is the code.


So I need the following help

1. I need to write a private sub procedure for the shape sizes which I can easily call, instead of writing the oshape.XXXX each time I paste a chart. I just

want a call sub that can easily be use for resizing based on my need


2. For example in PPT Slide 6, I want to copy  charts from Excel Sheet 4, Sheet 9 and Sheet 11 and use the resizing function on each. Is there a way I could create

array functions to store all these different charts and call each of them with a function e.g Chart(1).()2. Sorry I dont know how to fgure that out.

 Also if there is a shorter and smarter code, its welcomed

Thanks for your anticipated help



Sub xlToppt_Test()


    Dim ws As Worksheet

    Dim DestinationPPT As String

    Dim PPApp As PowerPoint.Application

    Dim PPPres As PowerPoint.Presentation

    Dim PPSlide As PowerPoint.Slide

    Dim oshape As PowerPoint.Shape


    Set PPApp = CreateObject(“PowerPoint.Application”)

    DestinationPPT = “\\main.bbb.corplm.local\RM-MMM$\Home\FBP\6\J0588\Desktop\HR things\Template.pptx”

    PPApp.Presentations.Open (DestinationPPT)

    Set PPPres = PPApp.ActivePresentation



    For Each ws In ThisWorkbook.Worksheets

          If ws.Name = “MT & OR Charts – Exc Adblue” Then


              ws.ChartObjects(“Chart 1”).CopyPicture Appearance:=xlScreen, Format:=xlPicture

              Set PPSlide = PPPres.Slides(6)


                With PPSlide

                    Set oshape = .Shapes(.Shapes.Count)

                End With


                    oshape.Left = 10

                    oshape.Top = 80

                    oshape.Width = 80

                    oshape.Height = 200


            ElseIf ws.Name = “MT & OR Charts” Then


              ws.ChartObjects(“Chart 1”).CopyPicture Appearance:=xlScreen, Format:=xlPicture

                            Set PPSlide = PPPres.Slides(7)


                With PPSlide

                    Set oshape = .Shapes(.Shapes.Count)

                End With


                    oshape.Left = 80

                    oshape.Top = 100

                    oshape.Width = 80

                    oshape.Height = 300


            End If

        End sub   


Top Contributor Asked 55 mins ago in VBA PowerPoint.
Add Comment
0 Answer(s)
  • Found this useful?

    Please share using the share button above.

    If you found the answer is best answer for your question, Please mark as 'best answer' by clicking on the right tick mark icon at the left side of the answer.

    Found the answer useful and wants to credit the user, then vote the answer (vote up).

  • Your Answer

    By posting your answer, you agree to the privacy policy and terms of service.