Consulting

Page 2 of 4 FirstFirst 1 2 3 4 LastLast
Results 21 to 40 of 71

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

  1. #21
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    No, the pictures don't really help. The best is a clear description of the problem. I think we're getting somewhere.

    Something like this might be what you need. Put each chart onto its own worksheet with no data on the sheet.

    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add
    
    ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets  If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then
        ' Data in sheet so copy used range
        objSheet.UsedRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
      Else
        ' No data in sheet, so copy chart
        objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
      End If
    
      'Create new slide for the data
      Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)
    
      ' paste the copied picture
      pptSld.Shapes.Paste
    
    Next
    Last edited by JonPeltier; 03-14-2016 at 11:46 AM. Reason: removed spurious [color] tags
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  2. #22
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    This gives a "Compile error: Syntax error". I believe the problem is in this area:

    ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then
    ' Data in sheet so copy used range
    objSheet.UsedRange[/COLOR][COLOR=#333333].CopyPicture Appearance:=xlScreen, Format:=xlPicture

    I tried to split the code in half, but it gives "wrong number of arguments or invalid property assignment".

    However, to get back to the topic, the first macro I posted of yours is working fine, which takes the arrays (per sheet) I selected. The only problem is that the report is a mix between tables and embedded charts in different sheets. The only thing the macro is currently missing is the fact that it doesn't take the graphs. I also tried to make them standalone, but without result unfortunately.

  3. #23
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    I do have something else though. That might be a little bit easier for me to explain and for you to understand. The only challenge I am facing for this is creating a "MyRange" per sheet. In the VBA script down below it takes the set "MyRange" for all sheets, but I would like to change that per sheet.

    Sub WorkbooktoPowerPoint()

    Dim pp As Object
    Dim PPPres As Object
    Dim PPSlide As Object
    Dim xlwksht As Worksheet
    Dim MyRange As String
    Dim MyTitle As String

    Set pp = CreateObject("PowerPoint.Application")
    Set PPPres = pp.Presentations.Add
    pp.Visible = True

    MyRange = "C9:V32"

    For Each xlwksht In ActiveWorkbook.Worksheets
    xlwksht.Select
    Application.Wait (Now + TimeValue("0:00:1"))
    xlwksht.Range(MyRange).CopyPicture _
    Appearance:=xlScreen, Format:=xlPicture

    SlideCount = PPPres.Slides.Count
    Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
    PPSlide.Select

    PPSlide.Shapes.Paste.Select
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pp.ActiveWindow.Selection.ShapeRange.Top = 1
    pp.ActiveWindow.Selection.ShapeRange.Left = 1
    pp.ActiveWindow.Selection.ShapeRange.Width = 700


    Next xlwksht

    pp.Activate
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set pp = Nothing

    End Sub


    For example:
    "Sheet 1" = C9:V30
    "Sheet 2" = C1:B25
    etc.

    Yours sincerely,

    Djani Sadloe

  4. #24
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Yeah, those stupid COLOR tags didn't belog. Somehow when I copied the code from above and typed it in, the editor inserted a lot of them and I only removed most of them. Try without these tags (I've corrected my post above).
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  5. #25
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    On each sheet, define a Name ("Named Range") that contains what you want to copy:

    Select the range.
    On the Formulas tab, click Define Name.
    In the dialog, enter a name, something like RangeToCopy
    In the dropdown for Scope, select the active sheet's name.

    Use the amended code:

    Set pptApp = CreateObject("PowerPoint.Application") 
    Set pptPre = pptApp.Presentations.Add 
     
     ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets  If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then 
         ' Data in sheet so copy used range
        objSheet.Range("RangeToCopy").CopyPicture Appearance:=xlScreen, Format:=xlPicture 
    Else 
         ' No data in sheet, so copy chart
        objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
    End If 
     
     'Create new slide for the data
    Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank) 
     
     ' paste the copied picture
    pptSld.Shapes.Paste 
     
    Next
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  6. #26
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Dear Jon,

    Thanks for helping me out. I really appreciate it.

    I have tested the script of your latest reply and it does work. However, when the macro is ran, it gives me the following error: "Application-defined or object-defined error".


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

    ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets
    If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then
    ' Data in sheet so copy used range
    objSheet.Range("RangeToCopy").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Else
    ' No data in sheet, so copy chart
    objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    End If

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

    ' paste the copied picture
    pptSld.Shapes.Paste

    Next
    End Sub


    The set ranges (scopes by Name Define) per sheet are all in the different slides in the PPT (as I wanted it to be), but for some reason it returns this error. VBA refers to the line which I made bold.

    Yours sincerely,

    Djani

  7. #27
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    I have also taken a look at your site (PeltierTech Excel/XL_PPT) to align the arrays/charts in the middle of the PPT presentation. This is very helpful!
    The following script works perfectly fine, but I need to adjust it to my needs somehow:

    ' Align pasted chart
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

    Do you have any tips on this point since I work with arrays instead of copy-pasting the chart(s)?

    Yours sincerely,

    Djani

  8. #28
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    I am also facing another big challenge that is an addition to the latest VBA script of yours by working with "Name Define". I'll try my best to explain it by sketching the following scenario:

    At this point there is a sheet that contains one table which is dynamic. The table allows us to make a choice on the model (9) and country (23) by selecting the criteria we want. However, as I am working with the "RangeToCopy" script, isn't it possible to create multiple "Name Defined" arrays that will be put into 1 slide? So let's say for example you will have a "RangeToCopy2".

    Even though I'm not sure whether this is the best solution, because this indicates that I will have to make either 9 slides with 23 tables (per country) and thus 9 x 23 Name Defined arrays. Do you have any tips for this? The dynamic table really is the bottleneck in this case I believe.

    I understand the photo will be small, but I have put it in the attachments so you have a better image of what I'm referring to.Yours sincerely,

    Djani Sadloe

  9. #29
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Quote Originally Posted by Djani View Post
    ... it gives me the following error: "Application-defined or object-defined error".
    Don't keep me in suspense. Where in the code does the error occur?
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  10. #30
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Quote Originally Posted by Djani View Post
    ... since I work with arrays instead of copy-pasting the chart(s)
    You keep saying "array". Do you mean "range"?

    Notice that for ranges and for charts, my code is copying as a picture, and the result is a shape on the slide. ShapeRange.Align works on whatever is the recently pasted shape.
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  11. #31
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Quote Originally Posted by JonPeltier View Post
    Where in the code does the error occur?
    Sorry, I initially read the post in the notification email, which didn't show the bold line that had the error.

    The error you posted occurs in the indicated line if the name does not exist on the sheet. Did you spell it correctly?
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  12. #32
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Quote Originally Posted by Djani View Post
    ... isn't it possible to create multiple "Name Defined" arrays that will be put into 1 slide?
    You can make this as complicated as you dare. You can use dynamic definitions for the Names in case the copied range changes size, and you can define multiple ranges in a sheet.

    To make the code work with multiple ranges, name them "RangeToCopy1", "RangeToCopy2", etc. You may want to limit these to a small number, like 2 or at most 3.

    Modify the code like this:

    Dim iName As Long, rName As Range
    
    Set pptApp = CreateObject("PowerPoint.Application") 
    Set pptPre = pptApp.Presentations.Add 
     
    ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets  
     
      'Create new slide for the data
      Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank) 
    
    
      If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then 
        ' Data in sheet so copy used range(s)
        
        For iName = 1 to 3
          ' initialize
          Set rName = Nothing
    
          ' look for named range
          On Error Resume Next
          set rName = objSheet.Range("RangeToCopy" & CStr(iName))
          On Error Goto 0
    
          If Not rName Is Nothing Then
            ' copy range as picture
            rName.CopyPicture Appearance:=xlScreen, Format:=xlPicture 
            ' paste the copied picture
            pptSld.Shapes.Paste 
          End If
        Next
    
      Else 
        ' No data in sheet, so copy chart
        objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
    
        ' paste the copied picture
        pptSld.Shapes.Paste 
      End If 
     
    Next
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  13. #33
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Dear Jon,

    I'm indeed referring to "ranges", so my apologies for using the wrong terminology. Thanks again for your help. I'll get back to you whenever I have tested the code. Really appreciate it.

    Regarding the error: I have checked if I misspelled the word "RangeToCopy" for the different ranges, but that doesn't seem to be the case. I am not sure what other reason there is to make this occur.

    Have a good day.

    Your sincerely,

    Djani
    Last edited by Djani; 03-15-2016 at 06:35 AM. Reason: Extra information

  14. #34
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Dear Jon,

    The query works perfect. I find it amazing that the script knows which "RangeToCopy" belongs to which sheet in the PowerPoint. One minor detail, every time I run the query, it adds 6 blank slides on top of the "filled slides" --> f.e. 5 filled slides + 6 blanks.

    Regarding the dynamic table: do you imply that, in my case, I have to make multiple tables - each indicating its own country/model? This would be my solution whatsoever. However, I was looking if it was possible to make a range indicate a snapshot of the chosen criteria on the table at that moment. I had made a "RangeToCopy1" and "RangeToCopy2" on the same exact range/cells (each one with different criteria), but it took the same one unfortunately. It's difficult to explain without seeing it, but is this even possible?

    Regarding the positioning: let's say I have "RangeToCopy1" and "RangeToCopy2" of a specific worksheet on 1PPT slide. How can I make the "RangeToCopy1" behave itself to the left side and "RangeToCopy2" on the right side?

    Yours sincerely,

    Djani
    Last edited by Djani; 03-15-2016 at 07:12 AM. Reason: misspelled words

  15. #35
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Positioning: The earlier snippets you found will center the shapes in the slide. You can also provide .top and .left properties to position and .height and .width properties to resize the shapes.

    You need logic that:

    If there is one shape, keep it centered.

    If there are two shapes, move the first to the left and the second to the right by enough that they don't overlap. You may need to resize them as well if they are large.

    A first cut (pseudocode):

    dim dSlideCenter as double
    with ppSld.Shapes(ppSld.Shapes.Count-1) ' first shape of two
    dSlideCenter = .left + .width/2
    .left = 1.5 * dSlideCenter - .width/2 ' center shape in left half of slide
    end with
    with ppSld.Shapes(ppSld.Shapes.Count) ' last shape of two
    .left = 1.5 * dSlideCenter + .width/2 ' center shape in right half of slide
    end with
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  16. #36
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Dynamic Table: If you have multiple things to filter, you need to apply one filter, copy and paste the range, apply another filter, copy and paste, etc. You could write this into the code, or you could make separate worksheets, each one filtered its own way, and use the existing code.
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  17. #37
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    Dear Jon,

    Thanks for your advice. I am going to make a table per sheet to make it easier for myself. However, when I paste the two codes into the 'existing/working VBA script' it gives me the following error: Method 'Add' of object 'Slides' failed.

    I might be doing it in the wrong order, since I am relatively new to VBA. This is the code as I have it right now:

    Sub PPT()
    
     
    Dim iName As Long, rName As Range
     
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPre = pptApp.Presentations.Add
     
     ' loop the sheets
    For Each objSheet In ActiveWorkbook.Worksheets
         
         'Create new slide for the data
        Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)
         
              
        If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then
             ' Data in sheet so copy used range(s)
             
            For iName = 1 To 3
                 ' initialize
                Set rName = Nothing
                 
                 ' look for named range
                On Error Resume Next
                Set rName = objSheet.Range("RangeToCopy" & CStr(iName))
                On Error GoTo 0
                 
                If Not rName Is Nothing Then
                     ' copy range as picture
                    rName.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                     ' paste the copied picture
                    pptSld.Shapes.Paste
                End If
            Next
             
        Else
             ' No data in sheet, so copy chart
            objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
             
             ' paste the copied picture
            pptSld.Shapes.Paste
        End If
    ' Align pasted chart
     PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
     PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
     
    Dim dSlideCenter As Double
    With ppSld.Shapes(ppSld.Shapes.Count - 1) ' first shape of two
        dSlideCenter = .Left + .Width / 2
        .Left = 1.5 * dSlideCenter - .Width / 2 ' center shape in left half of slide
    End With
    With ppSld.Shapes(ppSld.Shapes.Count) ' last shape of two
        .Left = 1.5 * dSlideCenter + .Width / 2 ' center shape in right half of slide
    End With
    It occurs at this piece of code: Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)

    Yours sincerely,

    Djani

  18. #38
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Hasn't that line of code been working already? Have you declared pptSld?

    Do you have Option Explicit at the top of the code module?
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

  19. #39
    VBAX Regular
    Joined
    Mar 2016
    Posts
    47
    Location
    I haven't got the "Option Explicit" on top of the code module --> this is for defining variables right?

    The script you see is everything I have. It has been working, but only when I leave the two tiny cuts of codes (one for centralization, one for putting tables/charts next to each other) out of it. As soon as I paste these scripts into the original "RangeToCopy" script then it gives the abovementioned error.

  20. #40
    MS Excel MVP VBAX Tutor
    Joined
    Mar 2005
    Posts
    246
    Location
    Okay, I've cleaned up the code. This is the entire module.

    I have not tested it, but I've looked it over pretty carefully, with your reported errors in mind. I've tried to use consistent variable names; the problem with copy-paste programming is that different snippets use different variable names and may have other subtle differences. Copy-Paste programming isn't bad, necessarily, I do it all the time, but you have to be aware of the gotchas.

    I assume only 1 or 2 named ranges on a sheet, or one chart if there are no named ranges.

    Option Explicit
    
    Sub PPT()
    
        Dim iName As Long
        Dim rName As Range 
        Dim nRange As Long
        Dim dSlideCenter As Double
        Dim pptApp As PowerPoint.Application
        Dim pptPre As PowerPoint.Presentation
        Dim pptSld As PowerPoint.Slide
        Dim objSheet As Worksheet
         
        Set pptApp = CreateObject("PowerPoint.Application") 
        Set pptPre = pptApp.Presentations.Add 
         
         ' loop the sheets
        For Each objSheet In ActiveWorkbook.Worksheets 
             
            'Create new slide for the data
            Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank) 
             
            If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then 
                ' Data in sheet so copy used range(s)
                 
                For iName = 1 To 2 
                    ' initialize
                    Set rName = Nothing 
                    nRange = 0
                     
                    ' look for named range
                    On Error Resume Next 
                    Set rName = objSheet.Range("RangeToCopy" & CStr(iName)) 
                    On Error GoTo 0 
                     
                    If Not rName Is Nothing Then 
                        ' counter
                        nRange = nRange + 1
                        ' copy range as picture
                        rName.CopyPicture Appearance:=xlScreen, Format:=xlPicture 
                        ' paste the copied picture
                        pptSld.Shapes.Paste 
    
                        ' Align pasted shape
                        pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
                        pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
                    End If 
                Next 
                 
            Else 
                ' No data in sheet, so copy chart
                objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
                 
                ' paste the copied picture
                pptSld.Shapes.Paste 
            End If 
    
            ' Align pasted shape
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
            pptApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
             
            If nRange = 2 Then
                 With ppSld.Shapes(ppSld.Shapes.Count - 1) ' first shape of two
                     dSlideCenter = .Left + .Width / 2 
                     .Left = 1.5 * dSlideCenter - .Width / 2 ' center shape in left half of slide
                 End With 
                 With ppSld.Shapes(ppSld.Shapes.Count) ' last shape of two
                     .Left = 1.5 * dSlideCenter + .Width / 2 ' center shape in right half of slide
                 End With 
            End If
        Next
    End Sub
    - Jon
    -------
    Jon Peltier, Microsoft Excel MVP
    Peltier Technical Services
    Tutorials and Custom Solutions
    http://PeltierTech.com
    _______

Posting Permissions

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