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コード
Option Explicit Private myRibbon As Office.IRibbonUI Private WithEvents App As Excel.Application Public Sub rbnSheetSelector_onLoad(ribbon As IRibbonUI) Set myRibbon = ribbon Set App = Application End Sub Private Sub App_WorkbookActivate(ByVal Wb As Workbook) myRibbon.InvalidateControl "dnmSheetSelector" End Sub Private Sub App_WorkbookDeactivate(ByVal Wb As Workbook) myRibbon.InvalidateControl "dnmSheetSelector" End Sub Private Sub App_WorkbookOpen(ByVal Wb As Workbook) myRibbon.InvalidateControl "dnmSheetSelector" End Sub Private Sub App_SheetActivate(ByVal Sh As Object) myRibbon.InvalidateControl "dnmSheetSelector" End Sub Public 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 0 End Sub Public 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 "xmlns", "http://schemas.microsoft.com/office/2006/01/customui" 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 0 End Sub
・リボンXML
<?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>
この記事へのコメントはありません。