PDA

View Full Version : Insert Excel Ranges in PowerPoint



ELSUIS
11-24-2017, 02:43 AM
Hi everyone!

I've the following piece of code which exports excel sheets to powerpoint. In each sheet it takes the range from cells A1 and A2 and copies that range into powerpoint.
Now I want to add two functions, but I'am stuck to fix this, so I am hoping anyone can help me with this?

1 - In sheets where only a table is included, the code does exactly what it's supposed to do. However in some sheets I've included a picture or a chart and these are not properly pasted in excel. (only a blank picture is copied in the powerpoint slide). Now I want to make a code that uses my input from cell "C1" to determine whether this slide needs to be pasted as an image or as a normal paste. I've tried to fix this but my code continuously gets an error. Is there any way that I can adjust this code so that I will get it working?

2 - The code now copies all worksheets, but I want it to start at sheet 7 and continue from there till the end. Thus skipping the first 6 worksheets. Does anyone have a clue how I can exclude these sheets in my VBA?



Sub PrintPPT()
'Step 1: Declare variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim MyRange As String

'Step 2: Open PowerPoint, add a new presentation and make visible
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True

'Step 3: Start the loop through each worksheet
For Each xlwksht In ActiveWorkbook.Worksheets
MyRange = xlwksht.Range("A1").Value & ":" & xlwksht.Range("A2").Value
xlwksht.Range(MyRange).Copy

'Step 4: Count slides and add new blank slide as next available slide number
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select

'Step 5: Paste the picture and adjust its position
PPPres.ApplyTemplate ("C:/My location/template.potx")

:dunno (This is the piece of code thats going wrong..)

PasteType = xlwksht.Range("C1").Value
' Pastetype is "PasteSpecial DataType:=2" for images
' Pastetype is "Paste.Select" for normal

PPSlide.Shapes.PasteType

:banghead:

pp.ActiveWindow.Selection.ShapeRange.Top = 85
pp.ActiveWindow.Selection.ShapeRange.Left = 7.2

'Step 6: Add the title to the slide then move to next worksheet
Next xlwksht

'Step 7: Memory Cleanup
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing

End Sub

Kenneth Hobs
11-24-2017, 11:05 AM
Welcome to the forum! Did you get an answer in the other forum(s) that you posted this to?

You can do an If() to check the worksheet's Index value to do the loop or not. You do a loop to check for paste:

IF PasteType=2 then
PPSlide.Shapes.PasteSpecial PasteType 'ppPasteEnhancedMetafile
Else
ppSlide.Shapes.Paste.Select
End If

ELSUIS
11-26-2017, 08:39 AM
Welcome to the forum! Did you get an answer in the other forum(s) that you posted this to?

You can do an If() to check the worksheet's Index value to do the loop or not. You do a loop to check for paste:

IF PasteType=2 then
PPSlide.Shapes.PasteSpecial PasteType 'ppPasteEnhancedMetafile
Else
ppSlide.Shapes.Paste.Select
End If


Hi Kenneth, thanks for your reply! I've tried it out and it worked like a charm. Someone else proposed the following, which also worked.. However within your line of code I can also change the formatting of both types of pasteTypes (for example I can now adjust the sizes of all pictures). So thanks a lot for this!


Dim PasteType as String PasteType = xlwksht.Range("C1").Value 'Where C1 = "ppPasteEnhancedMetafile"
PPSlide.Shapes.PasteSpecial (PasteType)

However the second question is still a mystery for me.. I can't get the same principle working to skip the first excel sheet (or more). I've tried the following:


For Each xlwksht In ActiveWorkbook.Worksheets
If xlwksht.Name = "Sheet1" Then
Else
MyRange = xlwksht.Range("A1").Value & ":" & xlwksht.Range("A2").Value
xlwksht.Range(MyRange).Copy
End If

But this doesn't work.. Do you maybe have a clue how to fix the error I am making?

Kenneth Hobs
11-26-2017, 10:18 AM
An IF/ELSE should suffice. Select Case will work as well. e.g.

For Each xlwksht In Worksheets
If xlwksht.Index >= 7 Then
MyRange = xlwksht.Range("A1").Value & ":" & xlwksht.Range("A2").Value
xlwksht.Range(MyRange).Copy
Else
'do other stuff?
End If
Next xlwksht

You can also loop by index.

Dim i As Integer
For i = 7 To Worksheets.Count
With Worksheets(i)
.Range([A1] & ":" & [A2]).Copy
End With
Next i

ELSUIS
11-27-2017, 12:48 AM
An IF/ELSE should suffice. Select Case will work as well. e.g.

For Each xlwksht In Worksheets
If xlwksht.Index >= 7 Then
MyRange = xlwksht.Range("A1").Value & ":" & xlwksht.Range("A2").Value
xlwksht.Range(MyRange).Copy
Else
'do other stuff?
End If
Next xlwksht

You can also loop by index.

Dim i As Integer
For i = 7 To Worksheets.Count
With Worksheets(i)
.Range([A1] & ":" & [A2]).Copy
End With
Next i




Thanks Kenneth, I've implemented the first line of code and it worked perfectly. :-)