サポンテ 勉強ノート

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

ワークシート上のセル選択範囲を画像ファイルとして保存【Excel/VBA/Windows】

はじめに

 先日の記事の姉妹版です。

 Excel のセルの選択範囲__セル範囲自体も、その上に描画されている図形なども__を画像ファイルとして出力します。Excel の「カメラ」機能で切り出した図をファイルにする感じですね。

 これもネットで調べると、同じような方法が見つかりますが、先日のマクロと同じく、A1 セルにパスを入力しておく形で実現します。

使い方

  1. A1 セルに、画像を出力したいパスを入力します。
  2. 画像として出力したいセル範囲を選択します。
  3. マクロ「現在のワークシートの選択範囲を画像ファイルとして保存()」を実行します。

VBA ソースコード

 PowerShell を使っているので、Windows 専用となります。

Option Explicit

Sub 現在のワークシートの選択範囲を画像ファイルとして保存()
    If Not IsCellRangeSelect() Then
        MsgBox "セル範囲を選択してください。"
        Exit Sub
    End If
    
    Selection.Copy
    ActiveSheet.Pictures.Paste.Select
    
    Selection.Cut
    ActiveSheet.PasteSpecial _
        Format:="図 (PNG)", _
        Link:=False, _
        DisplayAsIcon:=False
    Selection.Cut
    SaveClipboardImage
End Sub

Sub SaveClipboardImage()
    Dim objWSH As Object
    Dim cmd As String
    
    Set objWSH = CreateObject("WScript.Shell")
    cmd = "PowerShell -NoLogo -ExecutionPolicy RemoteSigned -Command " & _
        """$Image = Get-Clipboard -Format Image; " & _
        "$Image.Save(\""" & ActiveSheet.Range("A1").Value & "\"")"""
    
    objWSH.Run cmd, 1, True
End Sub

Private Function IsCellRangeSelect() As Boolean
    On Error Goto ErrHandle
    
    Dim abr As String
    adr = Selection.Address
    IsCellRangeSelect = True
    Exit Function
    
ErrHandle:
    Err.Clear
    IsCellRangeSelect = False
End Function

注意事項

 先日の記事と同じような注意事項があります。

 A1 セルに入力されたパスに、同じ名称のファイルが存在していたら上書きします。サポンテの用途としてはそれが便利だったためです。

 クリップボードを経由して PowerShell で保存しています。マクロ実行後はクリップボードが書き換わります。

 上記のマクロは、エラー制御などの基本的な処理が実装されていません。個人で使うものなので割愛しました。

 使用する場合は、ご自身の用途に合わせて適切なエラー処理を加えてください。