vba - 将 ActiveWindow.SelectedSheets 存储为稍后引用的对象

我正在尝试编写一个宏来创建一个目录，列出用户当前选择的每个工作表的名称，以及它在打印时开始的页码。我从 this page 中获取了代码并对其进行了如下修改。

但是，当创建新工作表(“内容”)时，它将成为事件的选定工作表，因此我无法再使用 ActiveWindow.SelectedSheets 来引用用户选择的工作表集合。所以我想在创建新工作表之前存储该信息。我怎样才能做到这一点？

如您所见，我尝试将其分配给 Worksheets 类型的变量，但这会生成错误消息。 (我也试过 Collection 但无济于事。)

Sub CreateTableOfContents()
    ' Determine if there is already a Table of Contents
    ' Assume it is there, and if it is not, it will raise an error
    ' if the Err system variable is > 0, you know the sheet is not there
    Dim WST As Worksheet
    Dim SelSheets As Worksheets

    Set SelSheets = ActiveWindow.SelectedSheets

    On Error Resume Next
    Set WST = Worksheets("Contents")
    If Not Err = 0 Then
        ' The Table of contents doesn't exist. Add it
        Set WST = Worksheets.Add(Before:=Worksheets("blankMagnitude"))
        WST.Name = "Contents"
    End If
    On Error GoTo 0

    ' Set up the table of contents page
    WST.[A2] = "Table of Contents"
    With WST.[A6]
        .CurrentRegion.Clear
        .Value = "Subject"
    End With
    WST.[B6] = "Page(s)"
    WST.Range("A1:B1").ColumnWidth = Array(36, 12)
    TOCRow = 7
    PageCount = 0

    ' Do a print preview on all sheets so Excel calcs page breaks
    ' The user must manually close the PrintPreview window
    Msg = "Excel needs to do a print preview to calculate the number of pages." & vbCrLf & "Please dismiss the print preview by clicking close."
    MsgBox Msg
    SelSheets.PrintPreview

    ' Loop through each sheet, collecting TOC information
    For Each S In SelSheets
        If S.Visible = -1 Then
            S.Select
            ThisName = ActiveSheet.Name
            HPages = ActiveSheet.HPageBreaks.Count + 1
            VPages = ActiveSheet.VPageBreaks.Count + 1
            ThisPages = HPages * VPages

            ' Enter info about this sheet on TOC
            WST.Select
            Range("A" & TOCRow).Value = ThisName
            Range("B" & TOCRow).NumberFormat = "@"
            If ThisPages = 1 Then
                Range("B" & TOCRow).Value = PageCount + 1 & " "
            Else
                Range("B" & TOCRow).Value = PageCount + 1 & " " ' & - " & PageCount + ThisPages
            End If
        PageCount = PageCount + ThisPages
        TOCRow = TOCRow + 1
        End If
    Next S
End Sub

最佳答案

我刚刚修改了你的代码。这是你正在尝试的吗？老实说，你所要做的就是

将 Dim SelSheets As Worksheets 更改为 Dim SelSheets，您的原始代码就可以工作了:)

Option Explicit

Sub CreateTableOfContents()
    Dim WST As Worksheet, S As Worksheet
    Dim SelSheets
    Dim msg As String
    Dim TOCRow As Long, PageCount As Long, ThisPages As Long
    Dim HPages As Long, VPages As Long

    Set SelSheets = ActiveWindow.SelectedSheets

    On Error Resume Next
    Application.DisplayAlerts = False
    Worksheets("Contents").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set WST = Worksheets.Add(Before:=Worksheets("blankMagnitude"))

    With WST
        .Name = "Contents"
        .[A2] = "Table of Contents"
        .[A6] = "Subject"
        .[B6] = "Page(s)"
        .Range("A1:B1").ColumnWidth = Array(36, 12)
    End With

    TOCRow = 7: PageCount = 0

    msg = "Excel needs to do a print preview to calculate the number of pages." & vbCrLf & "Please dismiss the print preview by clicking close."

    MsgBox msg

    SelSheets.PrintPreview

    For Each S In SelSheets
        With S
            HPages = .HPageBreaks.Count + 1
            VPages = .VPageBreaks.Count + 1
            ThisPages = HPages * VPages

            WST.Range("A" & TOCRow).Value = .Name
            WST.Range("B" & TOCRow).NumberFormat = "@"

            If ThisPages = 1 Then
                WST.Range("B" & TOCRow).Value = PageCount + 1 & " "
            Else
                WST.Range("B" & TOCRow).Value = PageCount + 1 & " " ' & - " & PageCount + ThisPages
            End If

            PageCount = PageCount + ThisPages
            TOCRow = TOCRow + 1
        End With
    Next S
End Sub

编辑 :一件重要的事情。使用 OPTION EXPLICIT 总是好的 :)

关于vba - 将 ActiveWindow.SelectedSheets 存储为稍后引用的对象，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/10654703/