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>

















この記事へのコメントはありません。