2 Attachment(s)
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:
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
