need a macro to copy all graphs from excel to ppt

I have a excel workbook which has gtaphs in multiple worksheets. I need to Copy all the graphs to a dedicated ppt that i have on my system. I need the macro to call the desired ppt wer i want to save all the graphs as a picture. Also i have multiple similar excel workbools which has similar graphs that need to be copied.
Please assist on this if anyone can

Kindly assist if someone can..pls.as this wud help me in my project wrk time saving

Hi,

I just completed a similar task. Here is the code I used, it should get you started.

Sub powerpointimport()
Dim pp As PowerPoint.Application
Dim ppfile As PowerPoint.Presentation
Dim SlideNum As Integer

Set pp = CreateObject("PowerPoint.Application")
    pp.Visible = True
Set ppfile = pp.Presentations.Open("C:\insert path to file here") 'Insert the path to your file including file name


Workbooks("WorkbookName").Activate
    Sheets("SheetName").Select
        ActiveSheet.ChartObjects("ChartName").Activate
        ActiveChart.ChartArea.Copy
pp.Activate
    SlideNum = 1
    ppfile.Slides(SlideNum).Select

        With ppfile.Slides(SlideNum).Shapes.Paste
            .LockAspectRatio = msoFalse
            .Height = 330  'positions the picture
            .Width = 760   'positions the picture
            .Left = 10     'positions the picture
            .Top = 100     'positions the picture
        End With
        
End Sub

Hi,

Thnks for the reply, but the above code is dependent of sheets. I have multiple sheets in a workbook which has graphs. I wud want to copy all the graphs at once without making any changes to the code regularly.
Also, since the PPT i have already has the graphs as picture i wud want the macro to delete existing graph picture from the ppt slide and paste the new graph as picture from excel.

Please assist on this

Hi,

This will loop through all charts in your workbook and paste them onto separate slides in the pp presentation.

Sub powerpointimport()
Dim pp As PowerPoint.Application
Dim ppfile As PowerPoint.Presentation
Dim SlideNum As Integer
Dim sld As Slide
Dim lng As Long

Set pp = CreateObject("PowerPoint.Application")
    pp.Visible = True
Set ppfile = pp.Presentations.Open("C:\pathtofile\FileName.pptx") 'Insert the path to your file including file name

For Each sld In ppfile.Slides
    For lng = sld.Shapes.Count To 1 Step -1
        With sld.Shapes(lng)
            If .Type = msoPicture Then
                    .Delete
            End If
        End With
    Next
Next

Workbooks("Book1").Activate
SlideNum = 1
For Each Worksheet In ActiveWorkbook.Worksheets
    Worksheet.Activate
    For i = 1 To ActiveSheet.ChartObjects.Count
        ActiveSheet.ChartObjects(i).CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
        pp.Activate
        ppfile.Slides(SlideNum).Select

            With ppfile.Slides(SlideNum).Shapes.Paste
                .LockAspectRatio = msoFalse
                .Height = 330  'positions the picture
                .Width = 760   'positions the picture
                .Left = 10     'positions the picture
                .Top = 100     'positions the picture
            End With
    
        Workbooks("Book1").Activate
    Next i
    SlideNum = SlideNum + 1
Next Worksheet

End Sub

The delete picture loop I found here:
http://www.ozgrid.com/forum/showthread.php?t=52682

Thnx a lot..this helped me solve my issue..tinkered the code u gave as per my requirement and my problem is solved..
thnks a lot buddy..