Revised routine, with excel image adjustment in powerpoint slide.

Code:
Public Enum PasteFormat
    xl_Link = 0
    xl_HTML = 1
    xl_Bitmap = 2
End Enum

Sub Copy_Paste_to_PowerPoint(ByRef ppApp As Object, ByRef ppSlide As Object, ByRef PasteObject As Object, Optional ByVal Paste_Type As PasteFormat)

    '   Modified by     : LalitMohan @ ExcelFox.com


    Dim PasteRange      As Boolean
    Dim objChart        As ChartObject


    Select Case TypeName(PasteObject)
        Case "Range"
            If Not TypeName(Selection) = "Range" Then Application.Goto PasteObject.Cells(1)
            PasteRange = True
        Case "Chart": Set objChart = PasteObject.Parent
        Case "ChartObject": Set objChart = PasteObject
        Case Else
            MsgBox PasteObject.Name & " is not a valid object to paste. Macro will exit", vbCritical
            Exit Sub
    End Select
    
    ppApp.ActiveWindow.View.GotoSlide ppSlide.slidenumber
    
    On Error GoTo -1: On Error GoTo 0
    DoEvents
    
    If PasteRange Then
        If Paste_Type = xl_Bitmap Then
            '//Paste Range as Picture
            PasteObject.CopyPicture Appearance:=1, Format:=-4147
            ppSlide.Shapes.Paste.Select
        ElseIf Paste_Type = xl_HTML Then
            '//Paste Range as HTML
            PasteObject.Copy
            ppSlide.Shapes.PasteSpecial(8, link:=1).Select  'ppPasteHTML
        ElseIf Paste_Type = xl_Link Then
            '//Paste Range as Linked
            PasteObject.Copy
            ppSlide.Shapes.PasteSpecial(0, link:=1).Select   'ppPasteDefault
        End If
    Else
        If Paste_Type = xl_Link Then
            '//Copy & Paste Chart Linked
            objChart.Chart.ChartArea.Copy
            ppSlide.Shapes.PasteSpecial(link:=True).Select
        Else
            '//Copy & Paste Chart Not Linked
            objChart.Chart.CopyPicture Appearance:=1, Size:=1, Format:=2
            ppSlide.Shapes.Paste.Select
        End If
    End If
     
    '//Center pasted object in the slide
    With ppApp.ActiveWindow.Selection.ShapeRange
        .LockAspectRatio = False
        .Height = ppSlide.Parent.PageSetup.SlideHeight * 0.98
        .LockAspectRatio = False
        .Width = ppSlide.Parent.PageSetup.SlideWidth * 0.98
        .Align msoAlignCenters, True
        .Align msoAlignMiddles, True
    End With
    
    Call AppActivate("Microsoft Excel")
    
    PasteRange = Empty
    Set objChart = Nothing
    
End Sub
Example sub to call this routine

Code:
Sub LalitTest()
    
    Dim ppApp       As Object
    Dim ppSlide     As Object
    
    Application.ScreenUpdating = False
    On Error Resume Next
    Set ppApp = GetObject(, "Powerpoint.Application")
    On Error GoTo -1: On Error GoTo 0: Err.Clear
    
    If ppApp Is Nothing Then
        Set ppApp = CreateObject("Powerpoint.Application")
        ppApp.Visible = True
        ppApp.presentations.Add
    End If
    
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, 12) 'ppLayoutBlank
    Else
        ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, 12
        Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
    End If
    
    Call Copy_Paste_to_PowerPoint(ppApp, ppSlide, ActiveSheet.Range("Print_Area"), xl_Bitmap)
    
    Application.ScreenUpdating = True
    
    Set ppApp = Nothing
    Set ppSlide = Nothing
    
End Sub