目录vba-仅可见图纸

我正在尝试创建一个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

Dim sht作为工作表
将内容设置为工作表
Dim myArray作为变体
尺寸x和长度一样，y和长度一样
Dim shtName1作为字符串，shtName2作为字符串
将ContentName设置为字符串
"投入,
ContentName=“Contents”
'优化代码
Application.DisplayAlerts=False
Application.ScreenUpdating=False
'删除内容表（如果已存在）
出错时继续下一步
工作表（“内容”）。激活
错误转到0
如果ActiveSheet.Name=ContentName，则
myAnswer=MsgBox（“名为[”&ContentName&_
“]已创建，是否替换它？”，vbYesNo）
'用户是否选择了“否”或“取消”？
如果我的答案是肯定的，那么转到出口
'删除旧内容选项卡
工作表（ContentName）。删除
如果结束
'创建新内容页
工作表。在之前添加：=工作表（1）
'将变量设置为内容页
设置内容\u sht=ActiveSheet
'格式目录表
心满意足
.Name=ContentName
.范围（“B1”）=“目录”
.Range（“B1”）.Font.Bold=True
以
'使用工作表名称创建数组列表（不包括内容）
ReDim myArray（1到工作表。计数-1）
对于ActiveWorkbook.工作表中的每个sht
如果是sht.Name ContentName，那么
myArray（x+1）=sht.Name
x=x+1
如果结束
下一步
'按字母顺序排列阵列列表中的工作表名称
对于x=LBound（myArray）到UBound（myArray）
对于y=x到UBound（myArray）
如果UCase（myArray（y））

仅通过可见图纸循环：

---

如果sht.Name ContentName和sht.Visible，则工作表的

.Visible

属性有三个选项：

正如您可能想象的那样，0被转换为

False

，1或2被转换为

True

。如果尝试将

.Visible

转换为

布尔值，则会导致错误

因此，我们的想法是只在工作表中循环，这些工作表是可见的。如果工作表为
xlSheetVeryHidden
，只检查
sht.Visible
会导致错误，因为
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

因此，使用：

如果sht.Visible=xlSheetVisible和sht.Name ContentName
假设将sht.Visible转换为布尔值是有点危险的。我尝试添加sht.Visible=xlSheetVisible，而ToC现在只显示标题（“目录”）。还有一个错误-下标超出范围，我对此很好奇。@SmurfPulse-尝试找到一种方法，仅将
myArray
分配给可见的工作表。这
ReDim myArray（1到Worksheets.Count-1）
还获取隐藏的和非常隐藏的。