Vba 结束通过Excel中的工作表的For循环

如果有人能在以下方面提供帮助，我将不胜感激。以下代码从MS Excel复制一个范围，并将其粘贴到MS PowerPoint中。此外，还有一个循环，它遍历工作簿的所有工作表，并应用相同的复制粘贴公式。然而，当循环到达最后一个工作表时，我正在努力如何“关闭”循环。在代码末尾，我得到一个运行时错误“91”：未设置突出显示

sh（ActiveSheet.Index+1）的对象变量或With block变量。当我选择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

您的脚本在
工作表
中的循环工作做得很好，但实际上有一个内置的
集合
专门针对这种情况设计

此工作簿。工作表
包含
此工作簿
中的所有
工作表
——您可以这样循环：

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

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

这意味着您可以调整
For…Next
循环以如下方式工作：

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

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

利用
工作表
集合还可以帮助您避免使用
。选择
和
活动表
，这会给用户带来很多痛苦：

您将变量
sh
声明为
工作表
，但从未为其赋值。异常试图在状态为“未设置对象变量”时指出这一点

行中：

sh(ActiveSheet.Index + 1).Select

您正试图调用尚未赋值的
sh
工作表。看来你在这里做的作业不对。您可以使用类似于
ThisWorkbook.Worksheets（ActiveSheet.Index+1）的功能。选择
以实现此功能，但您的循环也必须修改才能正常工作

如果您只是尝试循环浏览工作簿中的所有工作表，那么只需使用内置集合，而无需担心如何处理索引

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

向上投票！这是一个非常好和正确的答案。你关于避免
.Select`和
ActiveSheet`的建议非常正确，我看你有经验。我不明白你为什么会被否决。Downvoter，你能解释一下吗？嘿@SQLPolice，谢谢你的客气话。我对否决票也有同样的疑问，但希望帮助OP的主要目标能够实现……谢谢@grovesNL，你说得对，我不知道内置的收藏。使用起来容易多了！对实际对象变量not set error@grovesNL的出色解释