首页 文章

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

提问于
浏览 次
-2

如果有人可以提供以下帮助，我将不胜感激 . 以下代码从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
excel vba excel-vba for-loop

2 回答

  • 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

    回复于
  • 1

    您将变量 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
    回复于

相关问题