java循环遍历表_结束遍历Excel中工作表的For循环

如果有人可以提供以下帮助，我将不胜感激 . 以下代码从MS Excel复制范围并将其粘贴到MS PowerPoint中 . 此外，还有一个循环遍历工作簿的所有工作表并应用相同的复制和粘贴公式 . 但是，I 'm struggling how to 1413310 the loop when it reaches the last worksheet. At the end of the code, I get a Run-time error ' 91'：当我选择Debug时，未设置的对象变量或With块变量突出显示 sh(ActiveSheet.Index + 1).Select .

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