创建自动生成的工作表菜单



我正在努力为自动生成的工作表菜单微调VBA。到目前为止,我有以下内容;

Dim objSheet As Worksheet
Worksheets("General Information").Activate
Range("W14").Select
For Each objSheet In ActiveWorkbook.Worksheets
If ActiveSheet.Name <> objSheet.Name Then
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & objSheet.Name & "'" & "!A1", TextToDisplay:=objSheet.Name
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireColumn.AutoFit
End If
Next objSheet

这非常有效。然而,我希望有一个固定的起点,因为前几张总是一样的。换言之,从第12个工作表开始,我就需要这个。

你能帮我添加这个吗,谢谢

这样尝试:

Const intSheetStart As Integer = 12
Dim intCount As Integer
Dim objSheet As Worksheet
Worksheets("General Information").Activate
Range("W14").Select
intCount = 0
For Each objSheet In ActiveWorkbook.Worksheets
intCount = intCount + 1
If intSheetStart <= intCount Then
If ActiveSheet.Name <> objSheet.Name Then
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & objSheet.Name & "'" & "!A1", TextToDisplay:=objSheet.Name
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireColumn.AutoFit
End If
End If
Next objSheet

此更改将起点设置为常量,然后对图纸进行计数,并且仅在当前图纸为起点或之后运行其余代码。

控制它的另一种方法是使用另一种循环,并在代码中设置起点。

For i = 12 To ActiveWorkbook.Worksheets.Count
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & Worksheets(i).Name & "'" & "!A1", TextToDisplay:=Worksheets(i).Name
ActiveCell.Offset(1).Select
ActiveCell.EntireColumn.AutoFit
Next i

这在如i= 12所示的第12张片材处开始计数,然后进行到最后一张片材Worksheets.Count

此外,不选择东西通常是一种很好的做法,所以这里有一个不选择单元格的版本:

Sub links()
Dim ws As Worksheet
Set ws = Worksheets("General Information")
For i = 12 To ActiveWorkbook.Worksheets.Count
ws.Hyperlinks.Add Anchor:=ws.Cells(i + 2, 23), Address:="", SubAddress:="'" & Worksheets(i).Name & "'" & "!A1", TextToDisplay:=Worksheets(i).Name
Next i
Cells(1, 23).EntireColumn.AutoFit
End Sub

对于一种更动态的方法,受sbgib启发:

Sub menu()
Dim ws As Worksheet, printRow As Long, startCol As Long
Const startSheet As Long = 12   '- Which sheet number to start from
printCol = 23                   '- Column "W" is column number 23
printRow = 14                   '- First row to add hyperlinks to
Set ws = Worksheets("General Information")
printRow = printRow - startSheet
For i = startSheet To ActiveWorkbook.Worksheets.Count
ws.Hyperlinks.Add Anchor:=ws.Cells(printRow + i, printCol), Address:="", SubAddress:="'" & Worksheets(i).Name & "'" & "!A1", TextToDisplay:=Worksheets(i).Name
Next i
Cells(1, printCol).EntireColumn.AutoFit
End Sub