Macro to copy paste specific charts and ranges to PPT

Hi,
Suppose I have an excel sheet in which, there are some graphs and the data is provided besides that.
I want to copy paste both the data range and the PPTs to the template which is saved in D drive.
Can you please provide me the macro or link which can do it?

Attaching a sample file and the PPT having desired result for your reference.

Thanks in advance


Excel to PPT Help.zip

Copying as pictures and pasing in the powerpoint may be an option

Please Login or Register  to view this content.

I dont have much idea in the macro to be true...
I am now using the below code

PHP Code: 

Sub CreatePowerPoint()




Answer = MsgBox("Are you sure you want to continue?" & vbNewLine & "Clicking 'YES' will create the DU Dashboard PPT" & vbNewLine & "You may want to set the range & Update VOC graph", vbYesNoCancel + vbInformation, "Warning: DU Dashboard graph")

If Answer = vbYes Then Else Exit Sub

 'Add a reference to the Microsoft PowerPoint Library by:
    '1. Go to Tools in the VBA menu
    '2. Click on Reference
    '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
 
    'First we declare the variables we will be using
        Dim newPowerPoint As PowerPoint.Application
        Dim activeSlide As PowerPoint.Slide
        Dim cht As Excel.ChartObject
     Dim PPT As PowerPoint.Application
 Set PPT = New PowerPoint.Application
 PPT.Visible = True
 PPT.Presentations.Open Filename:="Z:\Monthly Reports\DU Dashboard\Presentation2.pptx"
     'Look for existing instance
        On Error Resume Next
        Set newPowerPoint = GetObject(, "PowerPoint.Application")
        On Error GoTo 0
     
    'Let's create a new PowerPoint
        If newPowerPoint Is Nothing Then
            Set newPowerPoint = New PowerPoint.Application
        End If
    'Make a presentation in PowerPoint
        If newPowerPoint.Presentations.Count = 0 Then
            newPowerPoint.Presentations.Add
        End If
     
    'Show the PowerPoint
        newPowerPoint.Visible = True
    
    'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
        For Each cht In ActiveSheet.ChartObjects
        
        'Add a new slide where we will paste the chart
            newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
            newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
            Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
                
        'Copy the chart and paste it into the PowerPoint as a Metafile Picture
            cht.Select
            ActiveChart.ChartArea.Copy
            activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
    
        'Set the title of the slide the same as the title of the chart
            activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
            
        'Adjust the positioning of the Chart on Powerpoint Slide
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 15
            newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 80
        
            activeSlide.Shapes(2).Width = 200
            activeSlide.Shapes(2).Left = 505
            
        Next
     
    AppActivate ("Microsoft PowerPoint")
    Set activeSlide = Nothing
    Set newPowerPoint = Nothing
     
End Sub 


But it will be copying only the charts. What I want is, it should copy the data also 'Table' to which the graphs are connected as shown in the sample file. Please help.

ActiveChart.SeriesCollection(1).formula will give you a way of getting the range

for example this gives me on mine

=SERIES(,Sheet1!$E$6:$E$14,Sheet1!$F$6:$F$14,1)

so you could split this down using VBA function Split with comma as separator and then take the last but one result passed to the array

so dim a() as string
a = split( ActiveChart.SeriesCollection(1).formula,",")

something like that.

I found this...

First, my old macro will create the necessary PPT for me copying only the charts....

PHP Code: 

Sub Chart2PPT()
    Dim objPPT As Object
    Dim objPrs As Object
    Dim shtTemp As Worksheet
    Dim chtTemp As ChartObject
    Dim intSlide As Integer
    'Dim ppShape As PowerPoint.Shape
    
intSlide = 1
     
    Set objPPT = CreateObject("Powerpoint.application")
    objPPT.Visible = True
    objPPT.Presentations.Open Filename:="D:\Test.pptx"

    'objPPT.ActiveWindow.ViewType = 1 'ppViewSlide
     
    For Each shtTemp In ThisWorkbook.Worksheets
        For Each chtTemp In shtTemp.ChartObjects
            intSlide = intSlide + 1
            chtTemp.CopyPicture
            If intSlide > objPPT.Presentations(1).Slides.Count Then
                objPPT.ActiveWindow.View.GotoSlide Index:=objPPT.Presentations(1).Slides.Add(Index:=intSlide, Layout:=1).SlideIndex
                Else
    objPPT.ActiveWindow.View.GotoSlide intSlide
End If
                    
   
        objPPT.ActiveWindow.View.Paste
                       
        
        
        
        Next
    Next
    

    
          
End Sub 


and then, it will then execute the below codes

PHP Code: 

Sub export_to_ppt3()
     ' Uses Early Binding to the PowerPoint Object Model
     ' Set a VBE reference to Microsoft PowerPoint Object Library
    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
     
     ' Reference existing instance of PowerPoint
    On Error Resume Next
    Set PPApp = GetObject(, "Powerpoint.Application")
    On Error GoTo 0
    If PPApp Is Nothing Then
        Set PPApp = New PowerPoint.Application
        PPApp.Visible = True
        Set PPPres = PPApp.Presentations.Open("D:\Test.pptx")
    Else
        Set PPPres = PPApp.ActivePresentation
    End If
    PPApp.ActiveWindow.ViewType = ppViewSlide
     
    PasteRng PPPres, 2, Range("RAN1")
    PasteRng PPPres, 3, Range("RAN2")
    PasteRng PPPres, 4, Range("RAN3")

     
     ' Clean up
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
End Sub 


and I will have to save this code somewhere..

PHP Code: 

Sub PasteRng(Pres, SlideNo, Rng As Range)
    Rng.Copy ' copy the range
    Pres.Application.ActiveWindow.View.GotoSlide SlideNo 'PPSlide.SlideIndex    ' activate the slide no
    Pres.Application.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse ' paste using pastespecial method
End Sub 


But the problem is, it is not pasting the range as Picture as expected.. More like embedding. Can you please help me?

i would take the value passed, "RANx" presuming these are range names, and then range("RAN1").select
selection.copypicture and then paste them in. So a combination of the 2 yours and mine.


Rng.CopyPicture xlPrinter

My only knowledge in macro is to copy paste the code from here to the excel sheet.

Can you please do the required changes in the code and post here?
I know that, I am troubling you.. sorry for that....

Please Login or Register  to view this content.

Snap3.jpg

Getting this error Message

Thats coming from powerpoint not being able to paste it. You'll need to do some googleing on it i think.

I googled and got the answer to insert this code

PHP Code: 

ActiveWindow.ViewType = ppViewSlideSorter 


But I am getting a new Error now.Snap2.jpg