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
posted @ 2012-09-01 09:32  放飞梦想  阅读(364)  评论(0编辑  收藏  举报