Consulting

Results 1 to 7 of 7

Thread: Copy/paste from Excel to PowerPoint - Not looping properly

  1. #1
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location

    Copy/paste from Excel to PowerPoint - Not looping properly

    I have cobbled together the code below, which is meant to:
    • loop through many worksheets and for each picture found...
    • copy/paste picture to newly created, individual PPT slides.
    • copy/paste corresponding data table (located beneath picture) to the SAME individual newly created PPT slide
    • make slide title same as worksheet
    • repeat for each picture on a worksheet
    • repeat for all worksheets in workbook (except several excluded worksheets)


    I got the code to work perfectly - as long as I was limiting it to run on just ONE worksheet.
    When I add the loop to go through ALL the worksheets, things fall apart.

    My sense is that it's because I'm using .Select (which I know is a no-no, but was the only way I could come up with to accomplish my goal) and because perhaps I've screwed up with declaring/usage of some variables.



    I'm attaching the source Excel file and a sample of the desired outcome in PowerPoint.

    The code is missing the necessary commands to position and resize the pictures. I'll tackle that next.

    Also, if there are ways to improve the code, please do feel free to educate me. Since I'm fairly new to VBA, I'm still very literal in my English-to-VBA commands. I know that's rarely best practice, however.

    The code:
    Sub CPAT_ExcelToPowerPoint() '*****  THIS IS THE CORRECT CODE TO USE FOR COPYING CPAT FROM EXCEL TO POWERPOINT   *************************
    
    'Add a reference to the Microsoft PowerPoint Library by:
        '1. Go to Tools in the VBA menu
        '2. Click on Reference
        '3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay
     
    'Things left to do:
        '1.  Loop through all worksheets
        '2.  Resize/reposition the pictures
        '3.  Add the text boxes on each slide
        '4.  Make sure blank cells are addresed before copy/paste
        '5.  Will any columns need to be resized before copy/paste? I don't think so, because of Jill's work in BO, but need to check
        '6.  Change slide titles to be the same as the corresponding Excel worksheet
        
        
        
    'Declare variables
            
    Dim PPApp As PowerPoint.Application
    Dim PPPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim SlideCount As Integer
    Dim myShp As Shape
    Dim slTitle As String
    'Dim mysht As Worksheet
    
    
    'Start a new instance of Powerpoint
    Set PPApp = New PowerPoint.Application
    PPApp.Visible = True
    
    
    
    
    'Create new ppt
    Set PPPres = PPApp.Presentations.Add
        
    
    
            
    
    
            'Make sure the correct starting cell is selected in Excel, so that the 'CurrentRegion' selection will work
            Range("A2").Select
            
                    
                'Loop through all the pictures on the sheet. Select picture, copy it
                For Each Shape In ActiveSheet.Shapes
                   
                   If Left(Shape.Name, 7) = "Picture" Then
                        Shape.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                    End If
                    
                    DoEvents   'This line is added so that Excel has time to complete the copy/paste operation
                  
                  
                  
                  
                  'Create new slide
                  Set PPSlide = PPPres.Slides.Add(PPPres.Slides.Count + 1, ppLayoutTitleOnly)
                  PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex    ' activate the slide
                  
                  'Setting the slide title variable, based on the worksheet name
                  slTitle = ActiveSheet.Name
                  
                  'Paste the picture in the newly created slide
                  PPApp.ActiveWindow.View.Paste
                  DoEvents
                   
                  'Select first region of data
                  ActiveCell.CurrentRegion.Select
                  Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                  DoEvents
                  
                  'Paste the data in the newly created slide
                  PPApp.ActiveWindow.View.Paste
                  DoEvents
                  
                  'Select next region of data
                  Selection.End(xlToRight).Select
                  Selection.End(xlToRight).Select
                  
               
                  'Add the title to the slide
                  PPSlide.Shapes.Title.TextFrame.TextRange.Text = slTitle
                    
                Next Shape
    
    
    
    
    
    
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
        
         
    End Sub
    Attached Files Attached Files

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    Hi there,

    I am not going to recreate this for you but i have added a few lines of code and made it work with a selected few sheets.
    What i have done with it should help you piece together more of the code, its not ideal as it still uses select but it should help with the issues mentioned above.

    Sub CPAT_ExcelToPowerPoint()    
        Dim PPApp As PowerPoint.Application
        Dim PPPres As PowerPoint.Presentation
        Dim PPSlide As PowerPoint.Slide
        Dim v As Variant, sh
    
    
        Set PPApp = New PowerPoint.Application
        PPApp.Visible = True
        Set PPPres = PPApp.Presentations.Add
        x = 1
        
        v = Array("Pending Total", "Pending Where", "Closed Total", "Closed Where ")
        
        For Each sh In v
            Sheets(sh).Activate
            Range("A2").Activate
            For Each Shape In ActiveSheet.Shapes
                If Left(Shape.Name, 7) = "Picture" Then
                    Shape.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                    x = x + 1
                End If
                Set PPSlide = PPPres.Slides.Add(PPPres.Slides.Count + 1, ppLayoutTitleOnly)
                PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
                PPApp.ActiveWindow.View.Paste
                PPSlide.Shapes(x).ScaleHeight 0.75, msoFalse
                PPSlide.Shapes(x).Top = 120
                x = x + 1
                ActiveCell.CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture
                PPApp.ActiveWindow.View.Paste
                PPSlide.Shapes(x).ScaleHeight 0.75, msoFalse
                PPSlide.Shapes(x).Top = 350
                Selection.End(xlToRight).Select
                Selection.End(xlToRight).Select
                PPSlide.Shapes.Title.TextFrame.TextRange.Text = ActiveSheet.Name
                PPSlide.Shapes.Title.ScaleHeight 0.5, msoFalse
                x = 1
            Next Shape
        Next sh
        
        Set PPSlide = Nothing
        Set PPPres = Nothing
        Set PPApp = Nothing
    End Sub
    Hope this helps
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  3. #3
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    I just gave it a quick try here at home - it seems perfect. I'll run it at the office in a few hours. THANK YOU, georgiboy - you've really helped me again and I appreciate it.

  4. #4
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    Bad news - now it's not working properly. Throughout this project, I keep running into a similar problem that seems to be some sort of glitch when copy/pasting between Excel and Powerpoint.
    The workbook example I posted above is pared down, in order to fit the size requirement for sharing files here on the forum. In reality, the workbook will have several more sheets to run through.
    So, when I added those sheet names to the array you(georgiboy) created, my results are all over the place.
    I keep getting various run-time errors. I've researched all of them. I've tried "DoEvents", I've tried a call to a "hold on a minute and wait" function - but nothing works.
    Each time I run the script, a random number of pics/tables will copy/paste correctly - and then the script stops. Each time it stops, the specific run-time error is different, as is the line it is thrown on.
    I'm SOOO close to having this script working properly. If anybody has any ideas, I'd be most grateful.

  5. #5
    VBAX Regular
    Joined
    Mar 2019
    Posts
    73
    Location
    I've tried a few more things and my results just keep getting more and more unpredictable/odd. I changed the paste method and that resulted in the code running through a certain number of slides, and then Powerpoint crashes. Or, it will run through all the slides, but it will loop through THREE times, creating a Powerpoint presentation with 3X too many slides. In between these trial runs, nothing is changing about the code - just crazy results, each time the script runs. Running the code on a fewer number of worksheets also seems to impact the performance - the fewer the worksheets, the farther the code runs before crashing Powerpoint.

    My bosses are breathing down my neck on this one, as having the solution to our (silly) problem suddenly gained quite a bit of visibility with their bosses.

    I'm open to any and all suggestions. This seems like it should be so straight-forward, and yet....

    P.S. Research is showing me that many, MANY users before me have run into issues when trying to copy from (insert MS application name) to Powerpoint. But no real solutions, other than best-guesses.

  6. #6
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    The cause of the problems is probably the selection of ranges before copying them.

    Artik

  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    I'm not at a computer and I 've not examined the code in detail but it strikes me that the End If could do with being further down the code, perhaps even just before Next Shape.
    Last edited by p45cal; 05-19-2019 at 04:24 AM.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

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