Office関連

クイック アクセス ツールバーから表示中のブックにあるシートを選択表示するExcelアドイン

Excel MVPの井ノ上さんのブログに面白い記事がありました。

・Excelで目次(シートへのリンク)を作るマクロ | EX-IT
http://www.ex-it-blog.com/131119Excel-sheet-mokuji-macro

ハイパーリンクをクリックすると該当シートが表示される、”シートの目次“を作成する方法とそのマクロが紹介されています。
シート数が多い場合には目次があるととても便利ですね。

井ノ上さんのこの記事に刺激を受けて、私の方でも”クイック アクセス ツールバーから表示中のブックにあるシートを選択表示するExcelアドイン“を作成してみました。

アドインのダウンロード:SheetSelectorQAT.zip

上記Zipファイルを解凍後、アドインファイル(SheetSelector.xlam)をExcelのアドインフォルダにコピーして(同梱のアドインフォルダを開く.vbsを実行すると自動的にアドインフォルダが開きます)オプション画面からアドインを読み込むと、クイックアクセスツールバーに「ワークシート選択」メニューが表示されます。

SheetSelector_01

このメニューをクリックすると選択した名前のシートが選択表示されます。

マウスクリックはもちろんですが、アクセスキー(Alt + 数字キー)からでもシートを選択できるので、キーボードでExcelを操作している方にはこちらの方がお薦めです。

SheetSelector_02

また、当アドインの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>

コメント

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

  1. この記事へのトラックバックはありません。

Time limit is exhausted. Please reload CAPTCHA.

おすすめ記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP