Embed Excel range into Powerpoint

[MontanaVike]

First the info. I am using Office 2007.
I am trying to embed a range of Excel cells into a powerpoint slide. I have a macro that does the job pretty well but there is a small change that I want but can't figure out.

I want the Excel info to be completely embedded in the PP slide so if you double click the instered data it opens in PP for editing not a linked instance of Excel.

Here is the code as I currently have it (based on other code that I've been able to find). I think I need to change something in the "'Paste Range as Picture" area perhaps with the PasteSpecial command but I haven't really found anything that works.

Any tips?

________________________________

Sub Copy_Paste_to_PowerPoint()
'
'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE
    Dim ppApp As PowerPoint.Application
    Dim ppSlide As PowerPoint.Slide
 
'Original code sourced from Jon Peltier [URL]http://peltiertech.com/Excel/XL_PPT.html[/URL]
'This code developed at [URL]http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html[/URL]
 
    Dim SheetName As String
    Dim TestRange As Range
    Dim TestSheet As Worksheet
 
    Dim PasteRange As Boolean
    Dim RangePasteType As String
    Dim RangeName As String
    Dim AddSlidesToEnd As Boolean
 
'Parameters
'-----------------------------------
'SheetName           - name of sheet in Excel that contains the range or chart to copy
'PasteRange          - If True then Routine will copy and Paste a range
'RangePasteType      - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values
'RangeName           - Address or name of range to copy; "B3:G9" "MyRange"
'AddSlidesToEnd      - If True then appednd slides to end of presentation and paste.  If False then paste on current slide.
 
'use active sheet. This can be a direct sheet name
    SheetName = ActiveSheet.Name
 
'Setting PasteRange to True means that Chart Option will not be used
    PasteRange = True
' Change the value in RangeName to change the area on the sheet that is copied.
    RangeName = "B2:X36"
    RangePasteType = "Picture"
    RangeLink = True
 
 
    AddSlidesToEnd = True
 
 
'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
 
'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
'Add a presentation if none exists
    If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
 
'Make the instance visible
    ppApp.Visible = True
 
'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
    Else
        If AddSlidesToEnd Then
'Appends slides to end of presentation and makes last slide active
            ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
            ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
            Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
        Else
'Sets current slide to active slide
            Set ppSlide = ppApp.ActiveWindow.View.Slide
        End If
    End If
 
'Options for Copy & Paste Ranges
        If RangePasteType = "Picture" Then
 
[B]'Paste Range as Picture[/B]
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
             
         Else
'Paste Range as HTML
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select
 
        End If
 
' Align pasted chart
        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
 
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    Set ppApp = Nothing
 
End Sub