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>

コマンドマクロ一覧(Word 2013)前のページ

2013年10月の人気記事次のページ

関連記事

  1. Office関連

    「NetOffice」で簡単に.NETからOfficeを操作

    ネットで「NetOffice」なるツールがあることを知ったので、早速試…

  2. Excel

    Officeアプリケーションの「最近使用したファイル」を削除するVBScript

    WordやExcel等のOfficeアプリケーションでは、下記サイトに…

  3. Office関連

    VBAの力量をはかる3つの質問

    先日、Twitterではけた氏の面白いツイートがありました。3…

  4. Excel

    Adobe Readerを利用してPDFファイルのページ数を取得するVBAマクロ

    mougの回答用に書いたコードです。mougは半年でログが消えてし…

コメント

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

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP