2 Attachment(s)
When stepping through, code doesn't stop after this "paste" command...why?
The code posted here worked fine...until I added a For loop to go through all sheets.
I have an Excel workbook with multiple sheets, each sheet containing multiple picture objects, with corresponding data ranges. The code is meant to:
* For each sheet
* Copy first picture object
* Create Powerpoint presentation, insert slide
* Paste the picture object onto slide
* Go back to the Excel sheet
* Copy the data range that is directly below the picture object that was just copied
* Go back to the SAME slide in Powerpoint
* Paste the data range (AS A PICTURE) beneath the already-pasted picture object
* Repeat for all picture/data range combos on a sheet (creating a new PPT slide for every combo)
* Repeat for all sheets in workbook
The code ALMOST works. The problem is that it just keeps going through all of the picture/data ranges on the FIRST SHEET. It never progresses to the next sheet. HOWEVER, it is also executing the copy/paste of all those pic/range combos MULTIPLE times in Powerpoint (i.e. I should have the same number of slides as I have number of pic/range combos...but instead, I end up with THREE TIMES the number of slides, because it just keeps looping).
So, I'm trying to step through, line by line, to identify the issue (I did post this same script here yesterday, but with no luck...so I'm trying to troubleshoot on my own).
For some reason, when the script gets to this line...
PPApp.ActiveWindow.View.Paste
...the stepping stops and the code just runs all the way through (albeit incorrectly). I've never experienced that before with stepping.
Why is it doing that? Any assistance at all on this would be SOOO appreciated.
NOTE: The workbook attached here is pared down in order to meet the forum size limit. The actual workbook will have about 25 sheets.
Code:
Sub CPAT_ExcelToPowerPoint() '***** THIS IS THE CORRECT CODE TO USE FOR COPYING CPAT FROM EXCEL TO POWERPOINT *************************
'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
For Each mysht In ActiveWorkbook.Worksheets
If mysht.Name <> "Definition and Filter" And _
mysht.Name <> "Performance Summary" And _
mysht.Name <> "Perf Summary no Charts" Then
'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
End If
Next mysht
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
Attachment 24234Attachment 24235
