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