Office TANAKA - Excel VBA Tips[セルのコメントに画像を表示する]

セルにコメントを挿入するには、次のようにします。

Sub Sample1()
    With ActiveCell.AddComment
        .Text "これはコメントです"
        .Visible = True
    End With
End Sub

このように、セルのコメントには一般的に文字列を表示されますが、ちょっと工夫するとコメントに画像を表示することができます。コメント枠を右クリックして[コメントの書式設定]を実行すると[コメントの書式設定]ダイアログボックスが表示されます。このダイアログボックスの[色と線]タブを開くと、コメント枠の背景色を指定できます。この背景色には、グラフの系列などと同じように、グラデーションやテクスチャを設定できるだけでなく、背景に任意の画像を指定することも可能です。

この操作をマクロで実行してやればいいんです。
次のコードは、C:\Work\Sample.jpgをコメントで表示します。

Sub Sample2()
    With ActiveCell.AddComment
        .Shape.Fill.UserPicture "C:\Work\Sample.jpg"
        .Visible = True
    End With
End Sub

表示するだけならこれでいいのですが、表示された画像はコメント枠の大きさに合わせて、自動的に拡大縮小されてしまいます。画像の大きさを優先して、コメント枠の大きさを変更するにはどうしたらいいでしょう。コメント枠には大きさを自動調整するAutoSizeというプロパティがありますが、このプロパティで自動調整されるときは文字列が基準になります。今回のように、表示した画像に合わせて自動調整されることはありません。

コメント枠には、大きさをセンチメートルで指定する機能があります。そこで、先に表示したい画像の大きさを取得しておき、コメントの背景に画像を表示した後で、コメント枠の大きさを画像に合わせて設定することにしましょう。それには、次の2つの問題を解決しなければなりません。

画像の大きさをどうやって取得するか
画像の大きさをどうやってセンチメートルに変換するか

1.は意外と簡単な方法で実現できます。
UserFormのイメージコントロールに画像を表示するときに使うLoadPicture関数は、引数で指定した画像をPictureオブジェクトとして返します。PictureオブジェクトにはWidthプロパティとHeigtプロパティがありますので、それを調べれば画像の大きさがわかります。次のマクロは、C:\Work\Sample.jpgの大きさを表示します。

Sub Sample3()
    Dim IMG As Object
    Set IMG = LoadPicture("C:\Work\Sample.jpg")
    MsgBox IMG.Width & vbTab & IMG.Height
End Sub

あとは、2.の問題です。WidthプロパティとHeightプロパティで取得できる画像のサイズは単位がポイントです。このポイントをセンチメートルに変換するには、ApplicationオブジェクトのCentimetersToPointsメソッドを使います。

Sub Sample4()
    Dim IMG As Object
    Set IMG = LoadPicture("C:\Work\Sample.jpg")
    With ActiveCell.AddComment
        .Shape.Fill.UserPicture "C:\Work\Sample.jpg"
        .Shape.Height = Application.CentimetersToPoints(IMG.Height) / 1000
        .Shape.Width = Application.CentimetersToPoints(IMG.Width) / 1000
        .Visible = True
    End With
End Sub

これで、コメントに画像を表示することができました。商品台帳などで商品の画像をコメントとして表示したり、住所録や会員名簿などで顔写真や地図の画像を表示するなど、いろいろな場面で応用できそうです。

ただし、このようなコメントを挿入するマクロでは「そのセルに、すでにコメントが挿入されているか」の確認を忘れてはいけません。すでにコメントが挿入されているセルに対してAddCommentメソッドを実行するとエラーになるからです。

Sub Sample5()
    Dim IMG As Object
    If TypeName(ActiveCell.Comment) = "Comment" Then Exit Sub
    Set IMG = LoadPicture("C:\Work\Sample.jpg")
    With ActiveCell.AddComment
        .Shape.Fill.UserPicture "C:\Work\Sample.jpg"
        .Shape.Height = Application.CentimetersToPoints(IMG.Height) / 1000
        .Shape.Width = Application.CentimetersToPoints(IMG.Width) / 1000
        .Visible = True
    End With
End Sub