Excel to PowerPoint Charts VBA

Hi
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.Activate

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

              Set PPSlide = PPPres.Slides(6)

              PPSlide.Shapes.Paste

                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.Activate

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

                            Set PPSlide = PPPres.Slides(7)

              PPSlide.Shapes.Paste

                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   

    Next

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.