Macro : Paste multiple excel ranges into separate powerpoint slides

I have a monthly report spreadsheet with about 20 different cell ranges that each need to be pasted into pre existing powerpoint slides as an image and resized to a unique size per range pasted in.
There is also a pre-existing image on each slide (from the prior month) that needs to be removed. (This part isn't too much of an issue as they are quick to delete. The copy, pasting and manual resizing of each range is the trouble.)

I've had a play with a couple of macro's online but have only found ones to pay a single range without a choice in dimensions. Is there anything else I can try?

Let each range be Data1 Data2 Data3 etc.

Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

This would be my suggestion:

1. Create a Excel File for Each Data range and perhaps call each one Data1, Data2, etc.
2. Copy Each corresponding data from your Report Spreadsheet to each corresponding Data Excel file.
3. Save your changes
4. Go to power point and insert Object
5. Click Create from File
6. Browse the first relevant Data file
7. Tick the "Link" box
8 Click ok.

Now you can resize the sheet the exact way you'd like.

The next time you need to update your report, copy the updated information to each corresponding Data Spreadsheet and save your changes.
Then go to Powerpoint and right click each Spreadsheet image and select "Update Link"

This will update the spreadsheet without having to resize anything.
Hope that makes sense.
A problem you might have with my suggestion is if you need to send the Powerpoint file to someone, the link to the excel data spreadsheet will be broken. This is not too much of an issue, since they will get an error message about not being able to update or find the files. And if they click ok, it will still display the spreadsheet images so it doesn't really matter.
I have another suggestion. I just tried something which I thought wouldn't work but actually does.

Instead of Creating a seperate Data spreadsheets for each range, do the following:
1. In your Report Spreadsheet, select and copy the first relevant range.
2. Switch to Powerpoint and select Edit > Paste Special > Paste as link
3. This will do exactly the same thing except that it has the added benefit of being directly linked to your Report Spreadsheet. This should save you a lot of work next time since all you would need to do is to click update links when you open the powerpoint presentation, and everything will be updated.
Cloud Class® Course: MCSA MCSE Windows Server 2012

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

ketterjAuthor Commented:
It's important that the range is pasted as an image (So the works are not transparant).
It's not possible to split the spreadsheet into separate files due to the complexity of the workbook and the nature of it's use.
This macro does it perfectly but only for one range into a new slide :
 It would be great if anybody knows how to adapt it so it does multiple ranges to specified sheets, eg range2 to sheet2.

The automatic resizing or deletion of old image would just be a bonus.
I think this'll get you down the road a little further.  I've done charts and not ranges, but I've tried to adapt the code you sent with the code I use.
I hope it works ....
Be sure and save your work before you start mucking with this.

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
     'This code developed at
    Dim SheetName As String
    Dim TestRange As Range
    Dim TestSheet As Worksheet
    Dim TestChart As ChartObject
    Dim PasteChart As Boolean
    Dim PasteChartLink As Boolean
    Dim ChartNumber As Long
    Dim PasteRange As Boolean
    Dim RangePasteType As String
    Dim RangeName(20) As String
    Dim AddSlidesToEnd As Boolean
     'SheetName           - name of sheet in Excel that contains the range or chart to copy
     'PasteChart          -If True then routine will  copy and paste a chart
     'PasteChartLink      -If True then Routine will paste chart with Link; if = False then paste chart no link
     'ChartNumber         -Chart Object Number
     '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
    RangeName(1) = "A1:S12"
    RangeName(2) = "B1:T12"
    RangeName(3) = "C1:U12"
    RangeName(4) = "D1:V12"
    RangeName(5) = "E1:W12"
    RangePasteType = "HTML"
    RangeLink = 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
      strMsg = "There is no PowerPoint presentation open.  Open the presentation and try again."
      MsgBox (strMsg)
      GoTo errMsg1
    End If
     'Make the instance visible
    ppApp.Visible = True

    For i = 1 To 5
         'Error testing
        On Error Resume Next
        Set TestSheet = Sheets(SheetName)
        Set TestRange = Sheets(SheetName).Range(RangeName(1))
        On Error GoTo 0

        'go to slide
        objPPT.ActiveWindow.View.GotoSlide Index:=i
        On Error Resume Next
          'delete current chart
        On Error GoTo 0
         'Options for Copy & Paste Ranges and Charts
        If PasteRange = True Then
             'Options for Copy & Paste Ranges
            If RangePasteType = "Picture" Then
                 'Paste Range as Picture
                ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
                 'Paste Range as HTML
                ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select
            End If
'        Else
'             'Options for Copy and Paste Charts
'            Worksheets(SheetName).Activate
'            ActiveSheet.ChartObjects(ChartNumber).Select
'            If PasteChartLink = True Then
'                 'Copy & Paste Chart Linked
'                ActiveChart.ChartArea.Copy
'                ppSlide.Shapes.PasteSpecial(link:=True).Select
'            Else
'                 'Copy & Paste Chart Not Linked
'                ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
'                ppSlide.Shapes.Paste.Select
'            End If
        End If
         'Center pasted object in the slide
        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
        With ppApp.ActivePresentation.Slides(intSlide)
          With .Shapes(.Shapes.Count)
            .Top = 93
            .Left = 23
            .Height = 100
            .Width = 100
          End With
        End With
    Next i

    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    Set ppApp = Nothing

End Sub

Open in new window

ketterjAuthor Commented:
I get an 'object required' error with 'objPPT.ActiveWindow.View.GotoSlide Index:=i' highlighted on debug.
Do i need to make any changes to the code?
I also noticed the subsequent following lines of code. Are they also applicable ot my paste-as-image purpose ?

thank you.
I'm sorry about that.  I think you'll need to change objPPT to ppApp or ppSlide.
You'll also need to change intSlide to i in the Delete statement.
Lastly, the Delete statement is intended to delete whatever is currently on the slide before you paste your new ranges.  You may have to play around with the numbering a little (that is, it may need to be Shapes(1) or something.  It was 2 in my code because Shapes(1) was the slide title (at least I think that's what it was).
I'm sorry I can't provide exact assistance, but hopefully this helps.
ketterjAuthor Commented:
Hi I changed it to ppslide :         ppSlide.ActiveWindow.View.GotoSlide Index:=i
Error now is method or data member not found .
Would a bit of USD by pay pal be a good enough incentive for anybody to provide a complete solution?
ketterjAuthor Commented:
I ended up getting somebody to code me something up.
This Pastes any ranges starting with 'slde'  eg 'slide2' 'slide10' etc into the corresponding slide in an open instance of powerpoint. It also deletes any existing picture object on that slide
Anybody that wants to use it will need to rename the filename specified in there or change the code.

Sub copypaste()
Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
Dim ppPres As PowerPoint.Presentation
Dim Wb As Workbook
Dim PrsOpen As Boolean
Dim ExlOpen As Boolean

Dim Obj As Variant
Dim WbS As Workbook

Dim mName As Name
Dim mSlideNo As Integer
Dim mShape As Shape
Dim mWS As String
Dim mRng As String

Set Wb = ThisWorkbook

ExlOpen = False
'For Each WbS In Workbooks
' RS - this next line appears to check for the occurence of string txtexcel.text inside then
'    If InStr(LCase(txtExcel.Text), LCase(WbS.Name)) <> 0 Then
'        ExlOpen = True
'        Exit For
'    End If

If Not ExlOpen Then
    Set WbS = Workbooks("rs macro.xls")
End If

 '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

 'Make the instance visible
ppApp.Visible = True

PrsOpen = False

For Each ppPres In ppApp.Presentations
    If LCase(ppPres.Name) = "powerpoint.ppt" Then
        PrsOpen = True
        Exit For
    End If

If Not PrsOpen Then
    Set ppPres = ppApp.Presentations.Open(txtPPT.Text)
End If

 'Loops through all named ranges
For Each mName In WbS.Names
    'Checks if it is named for slides
    If LCase(Left(mName.Name, 5)) = "slide" Then
        'Gets slide number from range name
        mSlideNo = Val(Mid(mName.Name, 6))
        'Checks for valid slide number
        If ppPres.Slides.Count >= mSlideNo And mSlideNo <> 0 Then
            Set ppSlide = ppPres.Slides(mSlideNo)
            'Selects the slide
            'Checks for existing picture and deletes those
            For Each Obj In ppSlide.Shapes
                If Obj.Type = msoPicture Then
                End If
            'Gets sheet name from the range
            mWS = Split(mName.RefersTo, "!")(0)
            mWS = Replace(Replace(mWS, "=", ""), "'", "")
            'Gets range address from the range
            mRng = Split(mName.RefersTo, "!")(1)
            'Copies the range as picture
            'Pastes the picture
            'Aligns the picture
            ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
            ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
        End If
    End If

MsgBox "Done!", vbInformation

Set ppSlide = Nothing
Set ppApp = Nothing

End Sub

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.