Copy/paste from Excel to PowerPoint - Not looping properly

[ajjava]

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

[georgiboy]

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

[ajjava]

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.

[ajjava]

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.

[ajjava]

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.

[Artik]

The cause of the problems is probably the selection of ranges before copying them.

Artik

[p45cal]

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.