サポンテ 勉強ノート

サポンテの勉強ノート・読書メモなどを晒します。

利用できる imageMso を一覧するマクロ

背景

先日、幸運にも Kingsoft の Office スイートを試用する機会がありました。VBA も使えるエディションです。

主に MS Excel 代替の WPS Spreadsheets を確認しました。エンジニアの視点から、VBA の実行やカスタマイズしたリボンの挙動などを厳しく確認しましたが、再現性の高さに驚かされました 1 。VBE さえ付いています。

その他、自前で開発したアドインのリボンに使っている imageMso が一部表示されていないことにも気づきました 2

もし Kingsoft 製の Office に移行する場合、どういった imageMso が使えて(ちゃんと表示されて)、どういったものが使えないのか、開発者としてはこれを把握する必要があります。

下記のサイトを参考にして、imageMso を一覧するマクロを作成しました。

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

準備

まず、以下の MS サイトから imageMso の一覧「imageMso.txt」をダウンロードします。

Download Microsoft Office Document: [MS-CUSTOMUI2] Supporting Documentation from Official Microsoft Download Center

imageMso.txt の内容はタブ区切りテキストになっているので、そのまま「全選択」->「コピー」->ワークシートに「貼り付け」できます。

マクロを実行

コピペしたら、そのワークシートがアクティブになっている状態で以下のコードを実行します。

Option Explicit

Sub listupImageMso()
    Dim i As Long
    Dim lastRow As Long
    Dim tmpPath As String
    Dim tmpShape As Shape
    Dim cb As CommandBars
    
    lastRow = ActiveSheet.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    Rows("2:" & lastRow).RowHeight = 32
    tmpPath = Environ("temp") & "\tmpImage.png"
    Set cb = Application.CommandBars
    
    On Error Resume Next
    Application.ScreenUpdating = False
    
    For i = ActiveSheet.Shapes.Count To 1 Step -1
        ActiveSheet.Shapes(i).Delete
    Next
    
    For i = 2 To lastRow
        Cells(i, 4).Select
        stdole.SavePicture cb.GetImageMso(Cells(i, 1).Value, 32, 32), tmpPath
        
        Set tmpShape = ActiveSheet.Shapes.AddPicture( _
              Filename:=tmpPath, _
              LinkToFile:=False, _
              SaveWithDocument:=True, _
              Left:=Selection.Left, _
              Top:=Selection.Top, _
              Width:=0, _
              Height:=0)
              
        With tmpShape
            .ScaleHeight 1, msoTrue
            .ScaleWidth 1, msoTrue
        End With
        
        If i Mod 200 = 0 Then
            Debug.Print i
            DoEvents
        End If
    Next
    
    Application.ScreenUpdating = True
    On Error GoTo 0
    
    Range("A1").Select
    
End Sub

実行すると D 列に次々にアイコンのイメージが貼り付けられていきます。

このコードを Kingsoft の WPS Spreadsheets で実行すれば(実行できれば)使える imageMso が判ります。

残念ながら試用 PC は返却してしまったため、上記のコードが動作するのかどうか確認できませんでしたが、もし移行が必要になったらまたそのときに確認してみたいです。

この一覧は MS Excel で開発する場合にもリファレンスとして使えるため重宝しそうです。

VBAエキスパート公式テキスト Excel VBA ベーシック [模擬問題プログラム付き]

VBAエキスパート公式テキスト Excel VBA ベーシック [模擬問題プログラム付き]


  1. 個人的には Ctrl + ; での日付入力はできたのに、Ctrl + : での時刻入力ができなかったのが不満です。

  2. つまり逆に言うと、一部はちゃんと表示されるのです。すばらしい。