Excel MVPの井ノ上さんのブログに面白い記事がありました。
・Excelで目次（シートへのリンク）を作るマクロ | EX-IT
http://www.ex-it-blog.com/131119Excel-sheet-mokuji-macro
ハイパーリンクをクリックすると該当シートが表示される、”シートの目次“を作成する方法とそのマクロが紹介されています。
シート数が多い場合には目次があるととても便利ですね。
井ノ上さんのこの記事に刺激を受けて、私の方でも”クイック アクセス ツールバーから表示中のブックにあるシートを選択表示するExcelアドイン“を作成してみました。
アドインのダウンロード:SheetSelectorQAT.zip
上記Zipファイルを解凍後、アドインファイル(SheetSelector.xlam)をExcelのアドインフォルダにコピーして(同梱のアドインフォルダを開く.vbsを実行すると自動的にアドインフォルダが開きます)オプション画面からアドインを読み込むと、クイックアクセスツールバーに「ワークシート選択」メニューが表示されます。
このメニューをクリックすると選択した名前のシートが選択表示されます。
マウスクリックはもちろんですが、アクセスキー(Alt + 数字キー)からでもシートを選択できるので、キーボードでExcelを操作している方にはこちらの方がお薦めです。
また、当アドインのVBAコードとリボンXMLは下記になりますので、当ツールをカスタマイズしたい方は下記コードをご利用ください(InvalidateControlメソッドを呼び出すイベントは適当に設定してあるので、気になる方は修正してアドインをお使いください)。
・VBAコード
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 | Option ExplicitPrivate myRibbon As Office.IRibbonUIPrivate WithEvents App As Excel.ApplicationPublic Sub rbnSheetSelector_onLoad(ribbon As IRibbonUI) Set myRibbon = ribbon Set App = ApplicationEnd SubPrivate Sub App_WorkbookActivate(ByVal Wb As Workbook) myRibbon.InvalidateControl "dnmSheetSelector"End SubPrivate Sub App_WorkbookDeactivate(ByVal Wb As Workbook) myRibbon.InvalidateControl "dnmSheetSelector"End SubPrivate Sub App_WorkbookOpen(ByVal Wb As Workbook) myRibbon.InvalidateControl "dnmSheetSelector"End SubPrivate Sub App_SheetActivate(ByVal Sh As Object) myRibbon.InvalidateControl "dnmSheetSelector"End SubPublic Sub btnSheetSelector_onAction(control As IRibbonControl) On Error Resume Next ActiveWorkbook.Worksheets(CLng(control.Tag)).Select If Err.Number <> 0 Then MsgBox "エラーが発生しました。" & vbCrLf & "エラー内容:" & Err.Description, vbExclamation + vbSystemModal On Error GoTo 0End SubPublic Sub dnmSheetSelector_getContent(control As IRibbonControl, ByRef returnedVal) Dim ws As Excel.Worksheet Dim d As Object Dim elmMenu As Object Dim elmButton As Object Dim i As Long, j As Long i = 0: j = 1 '初期化 If App.Workbooks.Count < 1 Then Exit Sub On Error Resume Next Set d = CreateObject("MSXML2.DOMDocument") Set elmMenu = d.createElement("menu") elmMenu.setAttribute "itemSize", "normal" For Each ws In ActiveWorkbook.Worksheets If ws.Visible = xlSheetVisible Then If j > 9 Then j = 1 Set elmButton = d.createElement("button") elmButton.setAttribute "id", "btnSheetName" & CStr(i) elmButton.setAttribute "label", ws.Name & "(" & ChrW(38) & CStr(j) & ")" elmButton.setAttribute "imageMso", "FileNew" elmButton.setAttribute "supertip", ws.Parent.FullName elmButton.setAttribute "tag", ws.Index elmButton.setAttribute "onAction", "ThisWorkbook.btnSheetSelector_onAction" elmMenu.appendChild elmButton Set elmButton = Nothing i = i + 1 j = j + 1 End If Next d.appendChild elmMenu returnedVal = d.XML If Err.Number <> 0 Then MsgBox "エラーが発生しました。" & vbCrLf & "エラー内容:" & Err.Description, vbExclamation + vbSystemModal On Error GoTo 0End Sub |
・リボンXML
1 2 3 4 5 6 7 8 9 10 11 12 | <?xml version="1.0" encoding="utf-8"?><customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="ThisWorkbook.rbnSheetSelector_onLoad"> <ribbon> <tabs> <tab id="tabSheetSelector" label="SheetSelector Tab" visible="false"> <group id="grpSheetSelector" label="SheetSelector Group"> <dynamicMenu id="dnmSheetSelector" imageMso="SelectSheet" label="ワークシート選択" supertip="現在表示中のワークブックにあるシートを選択します。" size="large" getContent="ThisWorkbook.dnmSheetSelector_getContent" /> </group> </tab> </tabs> </ribbon></customUI> |
この記事へのコメントはありません。