Consulting

Page 1 of 4 1 2 3 ... LastLast
Results 1 to 20 of 71

Thread: Copy each excel worksheets and paste in each indivual slides

  1. #1
    VBAX Expert Shazam's Avatar
    Joined
    Sep 2005
    Posts
    530
    Location

    Copy each excel worksheets and paste in each indivual slides

    Here is the link I ask the question the first time.

    http://vbaexpress.com/forum/showthre...9284#post59284


    Can this code could be modified to work in power point?

    Option Explicit 
     
    Sub CombineFiles() 
     
        Dim Path            As String 
        Dim FileName        As String 
        Dim Wkb             As Workbook 
        Dim WS              As Worksheet 
     
        Application.EnableEvents = False 
        Application.ScreenUpdating = False 
        Path = "S:\Conference\Presentaions" 'Change as needed
        FileName = Dir(Path & "\*.xls", vbNormal) 
        Do Until FileName = "" 
            Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName) 
            For Each WS In Wkb.Worksheets 
                WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 
            Next WS 
            Wkb.Close False 
            FileName = Dir() 
        Loop 
        Application.EnableEvents = True 
        Application.ScreenUpdating = True 
     
    End Sub
    The reason is right now I'm showing all these worksheet tabs on a projector using excel at the production meeting. Can I run a macro on Excel or power point that it will copy each worksheet that are group objects and paste it in each individual slide in power point?

    I found this code but it does not do exactly how I would like it.

     
    Sub CopyXLChart()
    Dim xlApp As Object
    Dim xlWrkBook As Object
    Set xlApp = CreateObject("Excel.Application")
    Set xlWrkBook = lApp.Workbooks.Open"S:\Conference\PresentaionsChart as of 10-19-2005.xls")
     
    ' Copy the 1st chart object on the 1st worksheet
    ' you can use Cut instead.
    xlWrkBook.Worksheets(1).GroupObjects(1).Copy
     
    'Pastes the contents of the Clipboard into the active view.
    'Attempting to paste an object into a view that won't accept
    'will cause an error. Look up the help file for more info.
     
    ActiveWindow.View.Paste
     
    ' Close the open workbook.
    ' I have set the flag to FALSE so that in case I make any changes
    ' to the XL file I don't want to be prompted with the Save Dialog.
    ' No changes are saved
    xlWrkBook.Close False
    xlApp.Quit
     
    Set xlApp = Nothing
    Set xlWrkBook = Nothing
    End Sub
    Last edited by Shazam; 03-01-2006 at 08:37 PM.

  2. #2
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    Hi Shazam,

    Something to get you started, maybe. It's a late bind from Excel which pushes the used range to a powerpoint slide:

    [vba]Public Sub TransferToPPT()
    Dim objSheet As Worksheet
    Dim pptApp As Object
    Dim pptPre As Object
    Dim pptSld As Object

    'Create a new Powerpoint session
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add

    'Loop through each worksheet
    For Each objSheet In ActiveWorkbook.Worksheets
    'Create new slide for the data
    Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, 12) 'ppLayoutBlank = 12
    objSheet.UsedRange.Copy
    pptSld.Shapes.Paste
    Next objSheet

    'Activate PowerPoint application
    pptApp.Visible = True
    pptApp.Activate
    End Sub[/vba]

    HTH,
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  3. #3
    VBAX Expert Shazam's Avatar
    Joined
    Sep 2005
    Posts
    530
    Location
    Thanks Ken Puls,


    I used your code and I change it to pick up group objects. But its not really perfect. The first slide is transparent and can it be fit on the total slide? right now some of the charts is going over the slide.


     
    Public Sub TransferToPPT()
        Dim objSheet    As Worksheet
        Dim pptApp      As Object
        Dim pptPre      As Object
        Dim pptSld      As Object
        Dim Ch          As Chart
        Dim Wkb         As Workbook
        
       
         'Create a new Powerpoint session
        Set pptApp = CreateObject("PowerPoint.Application")
        Set pptPre = pptApp.Presentations.Add
         
         'Loop through each worksheet
        For Each objSheet In ActiveWorkbook.Worksheets
             'Create new slide for the data
            Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, 12) 'ppLayoutBlank = 12
            objSheet.GroupObjects.Copy
            pptSld.Shapes.Paste
        
        Next objSheet
         
         'Activate PowerPoint application
        pptApp.Visible = True
        pptApp.Activate
    End Sub

  4. #4
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    H Shazam,

    To be completely honest, powerpoint isn't my strong suit.

    I'm wondering, though... can you change the size of the shape that you're pasting the groupobject to? You may need to create a new shape on the slide, right after you create, in order to set it to a variable. Something like:

    [vba]set pptShp = pptSld.Shapes.Add
    With pptShp
    .Left = 10
    .Right = 100
    End With[/vba]

    Just a note... NONE of the above has been tested. I was musing over the method only, and have no idea if the object model supports what I've given you there. You'll need to do some sleuthing in powerpoint to verify.

    If you can wait till tonight, I can take a play with it then.

    Cheers,
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  5. #5
    VBAX Expert Shazam's Avatar
    Joined
    Sep 2005
    Posts
    530
    Location
    No prolblem Ken Puls I'll wait.

  6. #6
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    I'll give it a shot tonight.

    Is there any way you can upload a santized workbook to work with? It would save me guessing on the output.
    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  7. #7
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    I recommend you have a look at this web page. It has several examples showing how to get Excel content into PowerPoint. The last example also shows the syntax to scale the pasted object; adjust the scaling factor to fit the slide.

    http://peltiertech.com/Excel/XL_PPT.html
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  8. #8
    Moderator VBAX Guru Ken Puls's Avatar
    Joined
    Aug 2004
    Location
    Nanaimo, BC, Canada
    Posts
    4,001
    Location
    Fabulous!

    Jon, I have used and referred others to your site for anything Excel Chart related, but somehow I missed that page. There's some great stuff in there.

    Ken Puls, CMA - Microsoft MVP (Excel)
    I hate it when my computer does what I tell it to, and not what I want it to.

    Learn how to use our KB tags! -||- Ken's Excel Website -||- Ken's Excel Forums -||- My Blog -||- Excel Training Calendar

    This is a shameless plug for my new book "RibbonX - Customizing the Office 2007 Ribbon". Find out more about it here!

    Help keep VBAX clean! Use the 'Thread Tools' menu to mark your own threads solved!





  9. #9
    VBAX Expert Shazam's Avatar
    Joined
    Sep 2005
    Posts
    530
    Location
    Ok it took me awhile to complete this because I'm still learning vba. The only problem is I can't figuer it out how to center the pictures on the sildes. If anyone has any ideas that will be great. Also I will like to thanks Ken Puls for setting me in the right direction. For this code to work you need to put a asterisk "*" or some kind of last vaule. Look at the sample workbook below it will have a red asterisk in each worksheet so the code could determine where to select the range. Use the code below on the sample workbook then you will get a better understanding how this code works.


    Remember to set your reference library.

    Microsoft PowerPoint 11.0 Object Library


     
     Sub CopyToPowerPoint()
        Dim pptApp          As Object
        Dim pptPre          As Object
        Dim pptSld          As Object
        Dim PP_Presentation As PowerPoint.Presentation
        Dim L As Long, ws   As Worksheet
        Dim rngSel          As Range
        Dim objSheet        As Worksheet
        Dim wks             As Worksheet
        Dim wb              As Workbook
     
        'Shazam!!
        'Created final version 03-07-2006
     
         With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
        .AskToUpdateLinks = False
     
     
         On Error Resume Next
         'This will loop through all the worksheets in your workbook to select a range where you want to copy your range.
         'Need to put some kind a last vaule for your range to select your range.
        For Each objSheet In ActiveWorkbook.Worksheets
            objSheet.Activate
            Set rngSel = IncreaseUsedRange(ActiveSheet)
            rngSel.Select
        Next objSheet
        For L = 1 To Worksheets.Count
        Set ws = Worksheets(L)
        ws.Activate
     
      ' This will copy all ranges that you selected in your workbook and convert it into a picture
       For Each objSheet In ThisWorkbook.Worksheets
        Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
        'After copying your ranges as pictures it will delete the active cells
        Selection.Delete
        'Delete All active charts in your workbook
        ActiveSheet.ChartObject.Activate
        ActiveChart.ChartArea.Select
        ActiveWindow.Visible = False
        Selection.Delete
        'Need to keep your workbook visible
            For Each wb In Workbooks
            Windows(wb.Name).Visible = True
        Next
        'pasted all pictures from your selected ranges
        ActiveSheet.Paste
        Next objSheet
      ' Starting your next objective
      Next
         'Create a new Powerpoint session
        Set pptApp = CreateObject("PowerPoint.Application")
        Set pptPre = pptApp.Presentations.Add
     
         'Loop through each worksheet
        For Each objSheet In ActiveWorkbook.Worksheets
             'Create new slide for the data
            Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)
            objSheet.Pictures.Copy
            pptSld.Shapes.Paste
        Next objSheet
         'Activate PowerPoint application
        pptApp.Visible = True
        pptApp.Activate
        'Will save your file name with current date
        pptApp.ActivePresentation.SaveAs FileName:="C:\Meeting" & " " & Format(Date, "mm-dd-yyyy")
            On Error GoTo 0
            .EnableEvents = True
            .ScreenUpdating = True
            .DisplayAlerts = True
            .AskToUpdateLinks = True
          End With
    End Sub
    Public Function IncreaseUsedRange(ws As Worksheet) As Range
         'Function Purpose: Returns range from cell A1 to the last used cell
         '                  and then increases the range by one row and one column
     
        Dim FirstRow        As Long
        Dim LastRow         As Long
        Dim FirstColumn     As Integer
        Dim LastColumn      As Integer
     
     
        On Error Resume Next
        With ws
            LastRow = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     
            LastColumn = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
     
            Set IncreaseUsedRange = Range(.Cells(1, 1), .Cells(LastRow + 1, LastColumn + 1))
     
        End With
        On Error GoTo 0
     
    End Function

  10. #10
    VBAX Regular mike31z's Avatar
    Joined
    Apr 2005
    Location
    Highland, Wisconsin
    Posts
    89
    Location

    Excel selected cell to powerpoint

    Shazam Thanks for the code on excel to powerpoint.

    I know you wrote this over a year ago but yours is the only that will allow me to comp anythin into PowerPoint. Yours copied to much. Can you assist me in limiting the range down to the amoutn selected on the current active worksheet.

    mike in wisconsin.

  11. #11
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Shazam's code is rather inefficient. It loops among the sheets in the workbook four times instead of the one time which would be required, it dumps a picture of each worksheet's used range into the worksheet, then copies all pictures in each worksheet, not just the picture of the used range, into a slide. Also, he sets a reference to the PowerPoint object library, but late binds most of the PowerPoint object variables (i.e., declares them As Object).

    A more efficient way is following this untested code:
    [VBA] ' instantiate powerpoint
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add

    ' loop the sheets
    For Each objSheet in ActiveWorkbook.Worksheets
    objSheet.activate
    If TypeName(Selection) = "Range" Then
    ' copy the selection, if it's a range
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Create new slide for the data
    Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

    ' paste the copied picture
    pptSld.Shapes.Paste

    End If
    Next
    [/VBA]
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  12. #12
    VBAX Regular mike31z's Avatar
    Joined
    Apr 2005
    Location
    Highland, Wisconsin
    Posts
    89
    Location
    Jon thanks for your help, I did a workaround and I like it.

    Thanks

    Mike in wisconsin

  13. #13
    Hi Jon

    Can this code be modified to copy the contents of each sheet? (assume each sheet has contents fitting exactly one page). Thanks



    Quote Originally Posted by JonPeltier
    Shazam's code is rather inefficient. It loops among the sheets in the workbook four times instead of the one time which would be required, it dumps a picture of each worksheet's used range into the worksheet, then copies all pictures in each worksheet, not just the picture of the used range, into a slide. Also, he sets a reference to the PowerPoint object library, but late binds most of the PowerPoint object variables (i.e., declares them As Object).

    A more efficient way is following this untested code:
    [vba] ' instantiate powerpoint
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add

    ' loop the sheets
    For Each objSheet in ActiveWorkbook.Worksheets
    objSheet.activate
    If TypeName(Selection) = "Range" Then
    ' copy the selection, if it's a range
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Create new slide for the data
    Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

    ' paste the copied picture
    pptSld.Shapes.Paste

    End If
    Next
    [/vba]

  14. #14
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    That's pretty much what it does. What you could do is modify the range selection bit to use the print area of each sheet:

    [VBA]For Each objSheet In ActiveWorkbook.Worksheets
    objSheet.Activate

    ObjSheet.Range("Print_Area").CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Create new slide for the data
    Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

    ' paste the copied picture
    pptSld.Shapes.Paste

    Next[/VBA]

    or simply copy the used range:

    [VBA] ObjSheet.UsedRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    [/VBA]
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  15. #15
    Thanks

    How would you modify this code if you were a) doing the same for a word document to powerpoint (1 page per slide) and b) doing the same for an existing powerpoint doc to a new pp doc (slide for slide)?

    Kind Regards

    Quote Originally Posted by JonPeltier
    That's pretty much what it does. What you could do is modify the range selection bit to use the print area of each sheet:

    [VBA]For Each objSheet In ActiveWorkbook.Worksheets
    objSheet.Activate

    ObjSheet.Range("Print_Area").CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Create new slide for the data
    Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

    ' paste the copied picture
    pptSld.Shapes.Paste

    Next[/VBA]

    or simply copy the used range:

    [VBA] ObjSheet.UsedRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    [/VBA]

  16. #16
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Hi JonPeltier,

    My apologies for bringing this topic back to life, but I have got a question regarding your VBA script. It's working perfectly, but is it also possible to paste the existing charts (from different worksheets) into the PPT automatically together with the arrays? I tried to click on the chart, but the PPT gives nothing back. Rest (arrays) works fine.

    Yours sincerely,

    Djani Sadloe

  17. #17
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Djani -

    Which bit of code are you using (I posted a few pieces earlier)? Are the charts embedded on the copied worksheet, embedded on other worksheets, or standalone chart sheets?
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  18. #18
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Dear JonPeltier,

    Thanks for the quick reply. This is the code I am currently using:

    ' instantiate powerpoint
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add

    ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets
    objSheet.Activate
    If TypeName(Selection) = "Range" Then
    ' copy the selection, if it's a range
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    'Create new slide for the data
    Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

    ' paste the copied picture
    pptSld.Shapes.Paste

    End If

    Regarding the charts: its data is coming from a pivottable in another worksheet, so "embedded on other worksheets". Down below you will see a picture to confirm it.
    Yours sincerely,

    Djani

  19. #19
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    The chart is embedded in a worksheet? Doesn't the code hit its parent worksheet when it loops through the worksheets in the active workbook?

    Your image is too small to see any relevant details.
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  20. #20
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Your code 'walks through' every sheet indeed, so it hits the parent worksheet of the graph. However, if it's possible, it would be nice to have a combination of selected arrays and charts in the different slides of the PPT presentation.
    Unfortunately I'm restricted with the amount of links so I'm unable to send you a tinypic URL. The photo you will see is also quite small, but it is the parent worksheet and the source of the graph.

    Parent worksheet


    I hope this gives you a better understanding of what I'm referring to.

    Many thanks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •