-2

I would greatly appreciate if anyone can help with the following. The following code copies a range from MS Excel and paste it into MS PowerPoint. Additionally, there is a loop that goes through all the worksheets of the workbook and applies the same copy and paste formula. However, I'm struggling how to "close" the loop when it reaches the last worksheet. At the end of the code, I get a Run-time error '91': Object variable or With block variable not set that highlights sh(ActiveSheet.Index + 1).Select when I select Debug. 

Sub CreateDeck()

Dim WSheet_Count As Integer
Dim I As Integer
Dim Rng As Excel.Range
Dim PPTApp As PowerPoint.Application
Dim myPPT As PowerPoint.Presentation
Dim mySlide As PowerPoint.Slide
Dim myShapeRange As PowerPoint.Shape
Dim sh As Worksheet

'Set WSheet_Count equal to the number of worksheet in the active workbook

WSheet_Count = ActiveWorkbook.Worksheets.Count

'Around the world: The Loop

For I = 1 To WSheet_Count

'Copy Range from excel

Set Rng = ThisWorkbook.ActiveSheet.Range("A1:A2")

'Creat Instance for PowerPoint

On Error Resume Next

'Check if PowerPoint is open

Set PPTApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors

Err.Clear

'Open PowerPoint if it is not open

If PPTApp Is Nothing Then Set PPTApp = CreateObject(class:="PowerPoint.Application")

'Handle if PowerPoint cannot be found

If Err.Number = 429 Then
    MsgBox ("PowerPoint couldn't be found, aborting")
Exit Sub

End If

On Error GoTo 0

'Make PowerPoint Visible and Active


PPTApp.Visible = True
PPTApp.Activate

'Create New PowerPoint

If PPTApp Is Nothing Then
    Set PPTApp = New PowerPoint.Application
End If

'Make New Presentation

If PPTApp.Presentations.Count = 0 Then
    PPTApp.Presentations.Add
End If

'Add Slide to the presentation

PPTApp.ActivePresentation.Slides.Add PPTApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank

PPTApp.ActiveWindow.View.GotoSlide PPTApp.ActivePresentation.Slides.Count

Set mySlide = PPTApp.ActivePresentation.Slides(PPTApp.ActivePresentation.Slides.Count)

'Copy Excel Range

Rng.Copy

'Paste to PowerPoint and Position

mySlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile

Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)

'Set position

myShapeRange.Left = 0
myShapeRange.Top = 0
myShapeRange.Height = 450

'Clear the Clipboard

Application.CutCopyMode = False

'Next Worksheet tab

sh(ActiveSheet.Index + 1).Select

Next I

End Sub
ken.b89
  • 27
  • 5

2 Answers2

1

Your script does a great job of looping through the Worksheets, but there is actually a built-in Collection designed for this very situation.

ThisWorkbook.Worksheets contains all the Worksheets in ThisWorkbook -- you can loop through it like this:

Option Explicit
Public Sub LoopThroughAllWorksheets()
    Dim wks As Worksheet
    For Each wks In ThisWorkbook.Worksheets
        MsgBox "On sheet: " & wks.Index
    Next wks
End Sub

This means you can tweak your For...Next loop to work like this:

For Each sh in ThisWorkbook.Worksheets
    'do stuff, like:
    'Set Rng = sh.Range("A1:A2")
    'etc.
Next sh

Leveraging the Worksheets collection also helps you avoid using .Select and ActiveSheet, which can cause your users a lot of pain:

How To Avoid Using Select in Excel VBA Macros

Community
  • 1
  • 1
Dan Wagner
  • 2,693
  • 2
  • 13
  • 18
  • Upvote! This is a very good and correct answer. Your advice regarding avoiding `.Select´and `ActiveSheet` is very true, I see you have experience. Don't understand why you are getting downvoted. Downvoter, can you please explain ? – SQL Police Jul 05 '15 at 17:48
  • Hey @SQLPolice, thank you for the kind words. I wondered the same thing about the downvote, but hopefully the main objective of helping the OP was achieved... – Dan Wagner Jul 05 '15 at 17:56
1

You are declaring a variable sh as a Worksheet, but never assigning a value to it. The exception is trying to indicate this when it states "Object variable not set".

In the line:

sh(ActiveSheet.Index + 1).Select

You are trying to call the sh worksheet which has not yet been assigned a value. It seems that you are trying to make the assignment here which is not correct. You could use something like ThisWorkbook.Worksheets(ActiveSheet.Index + 1).Select in order to achieve this functionality, but your loop would also have to be modified for this to work.

If you are just trying to loop through all sheets in your workbook, you can simply use the built-in collection rather than worrying about how to handle the index.

Option Explicit
Dim ws As Worksheet
Sub MessageAllNames()
    For Each ws In ThisWorkbook.Worksheets
       ' Everything that should be contained within your loop, for example...
       MsgBox ws.Name
    Next ws
End Sub
grovesNL
  • 6,016
  • 2
  • 20
  • 32