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

Question

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

但是，当创建新工作表（“内容”）时，它将成为活动的选定工作表，这样我就不能再使用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

Answer 1

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

将Dim SelSheets As Worksheets更改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总是好的:)

Answer 2

Dim wks as Worksheet, strName as String

For each wks in SelSheets
     strName = strName & wks.Name & ","
Next

strName = Left(strName, Len(strName) -1)

Dim arrWks() as String
arrWks = Split(strName,",")

End Sub

您将在arrWks中按名称获得所有选定的工作表，然后您可以处理这些工作表。 您还可以在循环中将每个工作表名称添加到集合中，使其更加平滑。

最好尽可能远离ActiveSheet。 通过这种方式，您可以使用计数器和进程循环遍历数组

所以：

Dim intCnt as Ingeter
For intCnt = Lbound(arrWks) to UBound(arrWks)
     Worksheets(arrWks(intCnt)).Activate
     .... rest of code .... 
Next

取代

For Each S In SelSheets

Answer 3

您可以存储每个工作表的引用;

function getSheetsSnapshot() as Worksheet()
dim shts() As Worksheet, i As long
redim shts(ActiveWindow.SelectedSheets.Count - 1)
for i = 0 to ActiveWindow.SelectedSheets.Count - 1
    set shts(i) = ActiveWindow.SelectedSheets(i + 1)
next
getSheetsSnapshot = shts
end function

获取并存储它们：

dim oldsel() as Worksheet: oldsel = getSheetsSnapshot()

做你的东西，然后回头看原来选择的床单;

for i = 0 to ubound(oldsel)
    msgbox oldsel(i).name
next