目录vba-仅可见的纸张

时间:2018-02-26 13:54:00

标签: vba excel-vba excel

我尝试创建一个VBA代码,只为可见的工作表创建一个ToC。我在网上发现了一些VBA代码并将其修改为在循环中包含Visible = True,但是当我运行宏时隐藏的工作表仍在显示。我已经包含了下面的代码,并且非常感谢任何有关将其调整为仅显示可见纸张的建议。

Sub TableOfContents_Create()

'添加目录工作表以轻松导航到任何标签

Dim sht As Worksheet
Dim Content_sht As Worksheet
Dim myArray As Variant
Dim x As Long, y As Long
Dim shtName1 As String, shtName2 As String
Dim ContentName As String

'Inputs
  ContentName = "Contents"

'Optimize Code
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

'Delete Contents Sheet if it already exists
  On Error Resume Next
    Worksheets("Contents").Activate
  On Error GoTo 0

  If ActiveSheet.Name = ContentName Then
    myAnswer = MsgBox("A worksheet named [" & ContentName & _
      "] has already been created, would you like to replace it?", vbYesNo)

    'Did user select No or Cancel?
      If myAnswer <> vbYes Then GoTo ExitSub

    'Delete old Contents Tab
      Worksheets(ContentName).Delete
  End If

'Create New Contents Sheet
  Worksheets.Add Before:=Worksheets(1)

'Set variable to Contents Sheet
  Set Content_sht = ActiveSheet

'Format Contents Sheet
  With Content_sht
    .Name = ContentName
    .Range("B1") = "Table of Contents"
    .Range("B1").Font.Bold = True
  End With

'Create Array list with sheet names (excluding Contents)
  ReDim myArray(1 To Worksheets.Count - 1)

  For Each sht In ActiveWorkbook.Worksheets
    If sht.Name <> ContentName Then
      myArray(x + 1) = sht.Name
      x = x + 1
    End If
  Next sht

'Alphabetize Sheet Names in Array List
  For x = LBound(myArray) To UBound(myArray)
    For y = x To UBound(myArray)
      If UCase(myArray(y)) < UCase(myArray(x)) Then
        shtName1 = myArray(x)
        shtName2 = myArray(y)
        myArray(x) = shtName2
        myArray(y) = shtName1
      End If
     Next y
  Next x

'Create Table of Contents
  For x = LBound(myArray) To UBound(myArray)
    Set sht = Worksheets(myArray(x))
    sht.Activate
    With Content_sht
      .Hyperlinks.Add .Cells(x + 2, 3), "", _
      SubAddress:="'" & sht.Name & "'!A1", _
      TextToDisplay:=sht.Name
      .Cells(x + 2, 2).Value = x
    End With
  Next x

Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit


ExitSub:
'Optimize Code
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

End Sub

1 个答案:

答案 0 :(得分:1)

工作表的.Visible属性有三个选项:

enter image description here

您可以想象,0转换为False,1或2转换为True。如果您尝试将.Visible转换为Boolean值,则会导致错误。

因此,这个想法只能通过xlSheetVisible的工作表进行循环。如果工作表为sht.Visible,则仅检查xlSheetVeryHidden可能会导致错误,因为xlSheetVeryHidden已评估为True

Public Sub TestMe()
    Dim sht As Worksheet    
    Set sht = Worksheets(1)
    sht.Visible = xlSheetVeryHidden
    Debug.Print CBool(sht.Visible)  'prints true
End Sub

因此使用:

If sht.Visible = xlSheetVisible and sht.Name <> ContentName