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

Question

如果有人能提供以下帮助，我将不胜感激。以下代码从 MS Excel 中复制一个范围并将其粘贴到 MS PowerPoint 中。此外，还有一个循环遍历工作簿的所有工作表并应用相同的复制和粘贴公式。但是，当循环到达最后一个工作表时，我正在努力如何“关闭”循环。在代码的末尾，当我选择调试时，我得到一个运行时错误“91”：对象变量或未设置块变量，突出显示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

Answer 1

您的脚本在循环遍历Worksheets 方面做得很好，但实际上有一个内置的Collection 专为这种情况而设计。

ThisWorkbook.Worksheets 包含ThisWorkbook 中的所有Worksheets -- 你可以像这样循环遍历它：

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...Next 循环，使其像这样工作：

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

利用Worksheets 集合还可以帮助您避免使用.Select 和ActiveSheet，这会给您的用户带来很多痛苦：

How To Avoid Using Select in Excel VBA Macros

Answer 2

您将变量sh 声明为Worksheet，但从未为其赋值。当它声明“对象变量未设置”时，异常试图表明这一点。

行内：

sh(ActiveSheet.Index + 1).Select

您正在尝试调用尚未分配值的sh 工作表。看来您正在尝试在这里进行不正确的分配。您可以使用 ThisWorkbook.Worksheets(ActiveSheet.Index + 1).Select 之类的东西来实现此功能，但您的循环也必须进行修改才能使其正常工作。

如果您只是想遍历工作簿中的所有工作表，则可以简单地使用内置集合，而不必担心如何处理索引。

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