?
Solved

Macro : Paste multiple excel ranges into separate powerpoint slides

Posted on 2010-04-01
9
Medium Priority
?
2,155 Views
Last Modified: 2012-05-09
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.

Regards
Robert
0
Comment
Question by:ketterj
  • 4
  • 3
  • 2
9 Comments
 
LVL 5

Expert Comment

by:ydsonline
ID: 29326212
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.
0
 
LVL 5

Expert Comment

by:ydsonline
ID: 29326499
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.
0
 
LVL 5

Expert Comment

by:ydsonline
ID: 29327492
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.
0
Learn to develop an Android App

Want to increase your earning potential in 2018? Pad your resume with app building experience. Learn how with this hands-on course.

 

Author Comment

by:ketterj
ID: 29333966
Hi
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 :
http://www.excelforum.com/excel-programming/626950-macro-for-excel-and-powerpoint.html
 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.
0
 
LVL 12

Expert Comment

by:sdwalker
ID: 29400296
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.
sdwalker

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 http://peltiertech.com/Excel/XL_PPT.html
     'This code developed at http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html
     
    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
     
     'Parameters
     
     '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
            objPPT.ActivePresentation.Slides(intSlide).Shapes(2).Delete
        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
                Worksheets(SheetName).Range(RangeName(i)).Copy
                ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
            Else
                 'Paste Range as HTML
                Worksheets(SheetName).Range(RangeName(i)).Copy
                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
     
errMsg1:

End Sub

Open in new window

0
 

Author Comment

by:ketterj
ID: 29539634
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 ?
objPPT.ActivePresentation.Slides(intSlide).Shapes(2).Delete

thank you.
0
 
LVL 12

Expert Comment

by:sdwalker
ID: 29550680
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.
0
 

Author Comment

by:ketterj
ID: 29636086
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?
0
 

Accepted Solution

by:
ketterj earned 0 total points
ID: 29909950
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 wbs.name then
'    If InStr(LCase(txtExcel.Text), LCase(WbS.Name)) <> 0 Then
'        ExlOpen = True
'        Exit For
'    End If
'Next

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
Next

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
            ppSlide.Select
            'Checks for existing picture and deletes those
            For Each Obj In ppSlide.Shapes
                If Obj.Type = msoPicture Then
                    Obj.Delete
                End If
            Next
            '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
            WbS.Worksheets(mWS).Range(mRng).CopyPicture
            'Pastes the picture
            ppSlide.Shapes.PasteSpecial(ppPasteDefault).Select
            'Aligns the picture
            ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
            ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
        End If
    End If
Next

MsgBox "Done!", vbInformation


Set ppSlide = Nothing
Set ppApp = Nothing

End Sub
0

Featured Post

[Webinar] Kill tickets & tabs using PowerShell

Are you tired of cycling through the same browser tabs everyday to close the same repetitive tickets? In this webinar JumpCloud will show how you can leverage RESTful APIs to build your own PowerShell modules to kill tickets & tabs using the PowerShell command Invoke-RestMethod.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
How can you see what you are working on when you want to see it while you to save a copy? Add a "Save As" icon to the Quick Access Toolbar, or QAT. That way, when you save a copy of a query, form, report, or other object you are modifying, you…

608 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question