4

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

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

3 回答 3

3

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

更改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

EDIT: One important thing. It's always good to use OPTION EXPLICIT :)

于 2012-05-18T15:24:09.073 回答
0 
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
于 2012-05-18T14:56:45.190 回答
0

您可以存储对每张工作表的引用；

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
于 2012-05-18T15:00:01.423 回答