VBA アドイン作成で使用するリボンアイコンの組み込み画像(ImageMSO)をBitmapで一括保存する方法

能書き ～ うんたらかんたら

Excel、Word、PowerPointでは作成したマクロをアドインとして保存することができる。また、オリジナルのリボンタブを作ってマクロを登録しておくと配布された側はリボンからボタンを押すだけで使えるので便利だ。

マクロ実行用のボタンにはアイコンを付けることができる。アイコンに使用できる画像はあらかじめOfficeに組み込まれている。種類も豊富なので選び放題。実行するマクロのイメージにマッチしたアイコンを選択することで、まるでプロが作った本格的な製品のように格好いいアドインになる。

と、こ、ろ、が。。

作る方はこれ、超めんどうくさい。(＠_＠;)

まずファイルを保存して閉じて、拡張子に.zipを付けてからExploreで開き、中にある「.rels」を編集し、さらにCustomUIというフォルダを作成して中に自分で作ったCustomUI.xmlを配置し、一旦Explorerを閉じて拡張子を元に戻してから開きなおすとようやくデザインしたリボンが現れる。

やったことない方は、この時点でちょっと引いてると思う。
まぁ、これはそんなに難しくない。また、リボンを作るための専用のツールもあるので、そういうのをダウンロードできる職場ならまぁ比較的楽に作れるだろう。

ツールを使ったリボンのカスタマイズはこちらがおススメ。
Office 2007/2010・リボンのカスタマイズ 初心者備忘録

ちなみに私の職場ではそうした外部ツールのダウンロードは禁止されているので、やはり手でXMLをいじるしかないのだけど。

Excel2013の方はこちらで手でリボンを作成する方法を動画で紹介した。
thom.hateblo.jp
※訳あって今は2010をメインで使ってて、2010だとxmlが微妙に違うのでこのままでは使えないのだけど、そこは適当に検索してほしい。

さて、しかし。
本当にめんどうなのは、そこじゃないんだ。

ナイスな画像を選ぶ。
これ。

これなんだよ。めんどうくさいのは。

好きなアイコンを選ぶってのは楽しそうに思えるかもしれないけど、Office2010に存在するアイコン名は約8600点。しかも系統別ではなく、アイコンの名称でアルファベット順に並んでいる。

しかも全く同じアイコンが別名で登録されてたりするもんだから、それらがノイズになって更に探しにくい。

アイコンサンプルを紹介しているサイトや図で選べるようなものもあるけれど、系統別に整理されたものは無く、私の知る限りすべてアルファベット順だ。

たとえば、こちらは2013のアイコン一覧。
www.ka-net.org

画像で見て探せるので、少なくともテキストだけよりは断然助かる。非常にありがたい。

しかし人間、欲深いもので、やっぱもっと楽に探したいなぁと思う。
たとえばファイルならファイルのアイコン、DBならDBのアイコンでまとまっていれば求めているものが探しやすい。

まぁ、それをサイトの主に求めるのはお門違いというもの。
それなら自分で作ってしまえ！ということで今回の記事はその前段階であるImageMSOをBitmapで保存するマクロの紹介。

前置きが長くなってしまったが、次項で実際にBitmap保存するマクロを紹介する。

全ImageMSOをBitmapで保存するマクロ

マクロを実行する前に、前準備が必要となる。
まずはImageMSOの一覧をMicrosoftのサイトからダウンロードしてくる。

Download Microsoft Office Document: [MS-CUSTOMUI2] Supporting Documentation from Official Microsoft Download Center
こちらのサイトでDownloadボタンを押すと何をダウンロードするか選択する画面になるので、「imageMSO.txt」にチェックを入れてダウンロードしよう。

そしてメモ帳などのエディタで開き、全選択してコピーする。

そして、Excelに張り付ける。

idMsoと書かれた1列目がImageMSOの名前である。
2列目が1ならOffice2010に存在し、3列目が1ならOffice2013に存在するという意味である。
ただ今回存在しないものはOn Errorで処理するので消してしまって良い。

次にImageMSOを保存するフォルダを作る。
今回はC:\work\ImageMSOとした。

そしてB列に保存するファイルのフルパスが入るように以下の数式を挿入する。

="C:\work\ImageMSO\"&A2&".bmp"

最後にオートフィルで最終行10237まで埋めたら前準備は完成。

次に、前準備に使用したシートのシートモジュールに以下のマクロを記述する。
今回はSheet1モジュールに記述した。

Sub SaveAllMsoAsBitmap()Dim bmp As IPictureDisp
    Dim cb As CommandBars: Set cb = Application.CommandBars
    Dim arr: arr = Range("A2:B10237").ValueOnErrorResumeNextFor i =LBound(arr,1)ToUBound(arr,1)
            stdole.SavePicture cb.GetImageMso(arr(i,1),32,32), arr(i,2)NextOnErrorGoTo0EndSub

これを実行すると、C:\work\ImageMSOに次々とアイコンが保存される。

A2:B10237とか、思いっきりハードコードしてるけど所詮一発ものなのでこれで十分。
ポイントはstdole.SavePictureと、cb.GetImageMsoである。

先ほど紹介した以下の記事の末尾にGetImageMsoメソッドの利用例が掲載されていたので、こちらを参考にさせていただいた。
www.ka-net.org

どうやらApplicationのCommandBarsオブジェクトにGetImageMsoというメソッドがあり、ここにImageMSOのID(つまり名前)を渡すと画像が得られるらしい。記事では80×80となっていたが、色々試した結果32×32にするとボケないことが分かったので今回は32×32で取得。

オブジェクトブラウザで確認すると、GetImageMsoはIPictureDispという型を返すようだ。

それならこれを保存する手はないかと色々検索してたら、標準で参照されているstdoleライブラリにSavePictureという命令があることが分かった。

こちらもオブジェクトブラウザで確認してみる。

確かにIPictureDisp型の値を引数に取っているようだ。

ということで、これらを組み合わせれば全ImageMSOの保存ができるというわけ。

今回はこれで以上。

次回は重複する画像の消し込みを紹介する。