EXCEL自动生成菜单
Sub AddMenuSheet()
'Check if sheet exists already; direct where to go if not.
On Error GoTo Nosheet
Sheets("Menu").Delete
Nosheet:
'Add sheet as the first sheet in the workbook.
Sheets.Add before:=Sheets(1)
On Error GoTo 0
ActiveSheet.Name = "Menu"
With Sheets("Menu")
.Cells(2, 2).Value = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
.Cells(2, 2).Font.Bold = True
' .Cells.Interior.ColorIndex = 37
.Rows.RowHeight = 20
.Columns(2).ColumnWidth = 3
shNumber = Worksheets.Count
For i = 1 To shNumber - 1
.Cells(i + 3, 1).Value = i
.Cells(i + 3, 3).Value = Sheets(i + 1).Name
shtName = Sheets(i + 1).Name
.Hyperlinks.Add .Range("C" & i + 3), "#'" & shtName & "'!A1", TextToDisplay:=shtName
Next
.Columns(3).AutoFit
End With
For i = 2 To shNumber
Sheets(i).Select
Cells(1, 50).End(xlToLeft).Offset(, 1).Select
If ActiveCell.Offset(, -1).Value = "Return To Menu" Then
ActiveCell.Offset(, -1).Clear
ActiveCell.Offset(, -1).Select
End If
ActiveSheet.Hyperlinks.Add Selection, "#'Menu'!A1", TextToDisplay:="Return To Menu"
Next
Sheets("menu").Select
End Sub
'Check if sheet exists already; direct where to go if not.
On Error GoTo Nosheet
Sheets("Menu").Delete
Nosheet:
'Add sheet as the first sheet in the workbook.
Sheets.Add before:=Sheets(1)
On Error GoTo 0
ActiveSheet.Name = "Menu"
With Sheets("Menu")
.Cells(2, 2).Value = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
.Cells(2, 2).Font.Bold = True
' .Cells.Interior.ColorIndex = 37
.Rows.RowHeight = 20
.Columns(2).ColumnWidth = 3
shNumber = Worksheets.Count
For i = 1 To shNumber - 1
.Cells(i + 3, 1).Value = i
.Cells(i + 3, 3).Value = Sheets(i + 1).Name
shtName = Sheets(i + 1).Name
.Hyperlinks.Add .Range("C" & i + 3), "#'" & shtName & "'!A1", TextToDisplay:=shtName
Next
.Columns(3).AutoFit
End With
For i = 2 To shNumber
Sheets(i).Select
Cells(1, 50).End(xlToLeft).Offset(, 1).Select
If ActiveCell.Offset(, -1).Value = "Return To Menu" Then
ActiveCell.Offset(, -1).Clear
ActiveCell.Offset(, -1).Select
End If
ActiveSheet.Hyperlinks.Add Selection, "#'Menu'!A1", TextToDisplay:="Return To Menu"
Next
Sheets("menu").Select
End Sub