Excel VBA: 工作表(Sheet)浏览导航插件

公司的日本人喜欢用excel写文档, 并且喜欢用很多的sheet,

然而在excel中, 随着工作表数量的增加, 工作表的浏览和定位就会变得麻烦起来,

于是我便希望能找到一个方法, 可以更容易, 更直观(一眼看到更多的sheet名)的导航sheet.

 

为此, 我google了一下,解决方案有下面两个

 

方法1 Dave Peterson's Sheet Navigator Toolbar for Workbook Sheets

详细网址如下:

http://www.contextures.com/xlToolbar01.html

效果图如下:

 

这个教程讲解的比较详细, 不仅付有Sheet Navigator的代码,

同时还附有如何自定义一个toolbar, 如果自定义这个Sheet Navigator toolbar.

链接上还附有这个excel插件的下载,

为了防止链接失效, 我把这个addin下载转载到了附件中,

将其置于下面路径中便可以直接使用:

C:\Documents and Settings\<windows username>\Application Data\Microsoft\AddIns

 

同时, 这个插件还有一个excel 2007的版本, 他们的界面有所不同.

Sheet Navigator - List and Sort Excel Sheets - Excel 2007

 

 

方法2. Bob Phillips' BrowseSheets

其中的两个连接如下:

http://help.lockergnome.com/office/Macro-Sheet--ftopict715336.html

http://www.pcreview.co.uk/forums/selecting-workbook-worksheet-browse-button-t966990.html

我自定义了excel的快捷键, 去去执行这段脚本, 同时也为他, 在我自定义的toobar上面追加了一个按钮

他的效果图如下:

代码如下:

 

Sub BrowseSheets()
Const nPerColumn  As Long = 38          'number of items per column
Const nWidth As Long = 13                'width of each letter
Const nHeight As Long = 18              'height of each row
Const sID As String = "___SheetGoto"    'name of dialog sheet
Const kCaption As String = " Select sheet to goto"
                                        'dialog caption

Dim i As Long
Dim TopPos As Long
Dim iBooks As Long
Dim cCols As Long
Dim cLetters As Long
Dim cMaxLetters As Long
Dim cLeft As Long
Dim thisDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As OptionButton

    Application.ScreenUpdating = False

    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If

    On Error Resume Next
        Application.DisplayAlerts = False
        ActiveWorkbook.DialogSheets(sID).Delete
        Application.DisplayAlerts = True
    On Error GoTo 0
    Set CurrentSheet = ActiveSheet
    Set thisDlg = ActiveWorkbook.DialogSheets.Add

    With thisDlg

        .Name = sID
        .Visible = xlSheetHidden

        'sets variables for positioning on dialog
        iBooks = 0
        cCols = 0
        cMaxLetters = 0
        cLeft = 78
        TopPos = 40

        For i = 1 To ActiveWorkbook.Worksheets.Count

            If i Mod nPerColumn = 1 Then
                cCols = cCols + 1
                TopPos = 40
                cLeft = cLeft + (cMaxLetters * nWidth)
                cMaxLetters = 0
            End If

            Set CurrentSheet = ActiveWorkbook.Worksheets(i)
            cLetters = Len(CurrentSheet.Name)
            If cLetters > cMaxLetters Then
                cMaxLetters = cLetters
            End If

            iBooks = iBooks + 1
            .OptionButtons.Add cLeft, TopPos, cLetters * nWidth, 16.5
            .OptionButtons(iBooks).text = _
                ActiveWorkbook.Worksheets(iBooks).Name
            TopPos = TopPos + 13

        Next i

        .Buttons.Left = cLeft + (cMaxLetters * nWidth) + 24

        CurrentSheet.Activate

        With .DialogFrame
            .Height = Application.Max(68, _
                Application.Min(iBooks, nPerColumn) * nHeight + 10)
            .Width = cLeft + (cMaxLetters * nWidth) + 24
            .Caption = kCaption
        End With

        .Buttons("Button 2").BringToFront
        .Buttons("Button 3").BringToFront

        Application.ScreenUpdating = True
        If .Show Then
            For Each cb In thisDlg.OptionButtons
                If cb.Value = xlOn Then
                    ActiveWorkbook.Worksheets(cb.Caption).Select
                    Exit For
                End If
            Next cb
        Else
            MsgBox "Nothing selected"
        End If

        Application.DisplayAlerts = False
        .Delete

    End With

End Sub

 

 

 

其他链接

 

Getting Started with Macros and User Defined Functions

http://dmcritchie.mvps.org/excel/getstarted.htm

Ron's Excel Tips

http://www.rondebruin.nl/tips.htm

Application Events

http://www.cpearson.com/excel/AppEvent.aspx

Events And Event Procedures In VBA

http://www.cpearson.com/excel/Events.aspx