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. Office関連

    Word 2013では文書にオンライン ビデオを挿入できるようになりました。

    ※ この情報はOffice 2013 カスタマー プレビュー版を元にし…

  2. Office関連

    [Office 365 Solo]日本語環境以外では使えるの?

    Office 365 Soloを使ってみて、疑問に思ったことの一つが“…

  3. Office関連

    Presentation Translatorが公開されました。

    下記記事で紹介している「Microsoft Translator アド…

  4. Office関連

    代替テキストを削除するPowerPointマクロ

    PowerPointの図やSmartArt、グループやグラフといった視…

  5. Office関連

    Office 2016関連資料のリンク(2)

    「Office 2016関連資料のリンク」では主にサポートサイトのリン…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP