選択範囲のセルを画像として保存する - 人はエクセルの能力の10%も使っていない？

やりたいのはエクセルのセルを画像として保存して、添付ファイルとしてメール送信です。mailItem.bodyには文字列しかセットできないのですが、セルの背景色情報がどうしても知りたいんです。特殊な条件で背景色を変更するようにセットしているからです。考えられる解決策は、① 画像ファイルとして保存して添付する　② HTMLフォーマットで記述してmailItem.HTMLBodyにセットする。今回は画像ファイルとして保存する方法を解説してみたいと思います。

世の中にはいろいろ知恵を絞ってる人がいるようで

mspaint.exeを立ち上げてSendKeys "^v", Trueすればいいじゃないかとか、ワークブックの実体はzipフォーマットなので拡張子を.zipに変えて、中にあるpngファイルを取り出せばいいとか、チャートに貼り付けてExportすれば10行でできるとか。

言うまでもなくチャートオブジェクトに貼り付けてjpgファイルとしてExportに決まりです。しかも、Pasteメソッドもあります。それにしてもチャートにそんなメソッドがあるとか知りませんでした。

デバッグモードでは問題ないが、普通に実行するとPasteが失敗する

xChart.Pasteするとチャートに何もペーストされないというバグでしばらく悩みました。デバッグモードではうまくいくのでさっぱり意味が分かりません。.CopyPictureしたシートにチャートオブジェクトを作らないとダメなのかと思いましたが、関係ありません。DoEventsを入れてみてもダメ。右クリックで出てくるポップアップメニューの貼り付けアイコンのあたりを上下に動かすと画像が出たり消えたりという不審な挙動があって、これがもしかしたら関係しているのかと思いましたが、関係なさそうです。

結局のところ.Selectで解決しました。全くの偶然で適当にやってみたらうまく行っただけの話でした。アクティブではないワークシートのセルを指定しても問題なく実行できるし、まぁ今回はこれでよしとしましょう。

Public Sub savePicture(pFileName As String, pRange As Excel.Range)

    Dim xChart  As Excel.Chart
    Dim xSheet  As Excel.Worksheet
 
    pRange.CopyPicture appearance:=xlScreen, Format:=xlPicture

    Set xSheet = pRange.Worksheet
    Set xChart = xSheet.ChartObjects.add(0, 0, pRange.Width, pRange.Height).Chart
    xChart.Parent.Select    '<== これかよっ
    xChart.Paste

    xChart.Export Filename:=pFileName, filtername:="JPG"
    xChart.Parent.Delete

End Sub

最後にファイル添付

Attachments.Add すればおしまいです。一応サンプルを載せておきます。

Private Sub SendMail()

    Dim oMail       As Outlook.MailItem
    Dim oOutLook    As Outlook.Application
    Dim xCell       As Excel.Range
 
    Set oOutLook = New Outlook.Application
    Set oMail = oOutLook.CreateItem(olMailItem)

    oMail.Subject = "本日の途中経過 " & Format(Now, "MM/DD hh:mm")

    modUtil.savePicture ThisWorkbook.Path & "\tmp1.jpg", Sheet8.Range("AD2:AK7")
    modUtil.savePicture ThisWorkbook.Path & "\tmp2.jpg", Sheet8.Range("AM2:AT7")
    modUtil.savePicture ThisWorkbook.Path & "\tmp3.jpg", Sheet8.Range("AV2:BC7")

    oMail.Attachments.Add ThisWorkbook.Path & "\tmp1.jpg"
    oMail.Attachments.Add ThisWorkbook.Path & "\tmp2.jpg"
    oMail.Attachments.Add ThisWorkbook.Path & "\tmp3.jpg"

    oMail.body = "Hello Sam! How is your quest going?"
    oMail.To = "sam.bridges@central.knot.city.com"
    oMail.send

End Sub