Insert Excel Ranges in PowerPoint

[ELSUIS]

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")

(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



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]

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]

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]

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]

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. :-)