今日を乗り切るExcel研究所

Excel に働かされていませんか

Excel の画像をファイルに保存したい

今回は、シートに貼り付けた画像をファイルに保存する方法について調べます。
また、それを自動化するマクロを作成します。

f:id:shego:20171203232642p:plain

貼り付け画像をファイルに保存できない

Excelシートには画像も貼り付けられるので、スクラップブック的な使い方もあります。

パソコン関連のブログなど書いていると、ウィンドウ画面のキャプチャ画像を沢山取るわけですが、それらを Excel シートに貼ってまとめておいたりします。
Excel には正にそのための「スナップショット」という便利機能があって重宝します。

しかし、せっかく集めたのキャプチャを画像ファイルとして書き出す機能がありません。
仕方ないので、いったん「ペイント」にコピー&ペーストして画像ファイルに保存するのですが、これがまた使えないソフトです。

ペイントはなぜかウィンドウを一つしか開けないので、ウィンドウを使い回すことになるため、サイズの違う画像を貼り付けるたびに余白をギリギリまで削ったり、無意識に Ctrl+S して前の画像を上書き保存してしまいやり直す羽目になるなど、「余計な仕事をやらされている感」が募ります。

Word や PowerPoint なら「図として保存」で画像をファイルに保存できるのに、Excel にそれが無いのは一体何の嫌がらせでしょうか。

Excel ファイルから画像と取り出してみる

調べた限り、Excel の機能を使って画像を保存する方法はなさそうです。

その代わり、Window 側から Excel ファイル(XLSX ファイル)の中の画像ファイルを取り出す方法が知られています。

XLSX ファイルの実体は ZIP 書庫なので、その拡張子を「.zip」に変更すれば、普通にWindows エクスプローラで中身を開くことができます。
その中を探すと貼り付け画像の PNG や JPEG ファイルが見つかります。

拡張子というのは、ファイルの種類を区別するために付加する、ファイル名の最後の部分です。
Excel ブックなら「 .xlsx 」、PNG 画像なら「.png」、ZIP 書庫なら「.zip」というように決まっています。

ではお目当ての Excel ファイルの拡張子を変更してみましょう。

はい、ありませんね、拡張子。

ファイル名の拡張子はふだん隠されていて、これを表示させるには自分で Windows の設定をする必要があります。
Windows のバージョンによって違うのですが、 Windows 10 ならフォルダの「表示」タブにある「拡張子を表示する」チェックボックスがそれです。

f:id:shego:20171202162956p:plain

拡張子が表示されたら、 Excel ファイルをコピーした上で、コピーの方のファイル名を編集(F2)して、「.zip」を最後に追加します。(必ずファイルをコピーをしてください)

そうすると、アイコンも ZIP に変わり、ZIPファイルとして開いたり解凍できるようになります。
その中の、xl¥media というフォルダに貼り付け画像が保存されています。

f:id:shego:20171202163043p:plain

各ファイルが image1.png のような連番で、ZIP 内ではプレビューアイコンも表示されないので、沢山あるとどれがどの画像だかわかりません。media フォルダごと ZIP の外に移動すればプレビューで確認できます。
拡張子が「.tmp」となっているファイルは、Excelの「スナップショット」機能を使って貼り付けた画像で、実体は PNG 画像なので拡張子を「.png」に変えてください。

まあ、これで画像は取り出せました。
ただ、難しい作業ではないとはいえ、働かされている感は拭えませんね。
なのでこういう操作はバッチで自動化してしまいましょう。

XLSX ファイルの画像フォルダを開くバッチ

if "%~x1"==".xlsx" (
copy %1 %1.zip
start "" "%~f1.zip\xl\media"
)

【作業手順】

  1. 上記バッチプログラムをテキストエディタ(メモ帳など)にコピー&ペーストします
  2. それに適当なファイル名をつけて バッチファイル(BAT ファイル)としてデスクトップなどに保存します
    • 拡張子を「.bat」にします。
  3. 画像を取り出したい XLSX ファイルのアイコンを、そのバッチファイルのアイコンにドラッグ&ドロップします。
  4. XLSX ファイルが ZIP ファイルとしてコピーされ、画像フォルダが自動的に開きます
    • エラーダイアログが出たら、XLSX ファイルに貼り付け画像が1枚も無いということです
  5. 画像ファイルを取り出し、 残りガラの ZIP ファイルを削除します。

便利そうですが、使ってみるとドラッグ&ドロップをするのにデスクトップまで戻るのが意外と手間です。

これをコンテキストメニューの「送る」に追加しておけばもう少し快適になるかもしれません。

  1. フォルダのアドレスバーに「shell:sendto」と入力して「送る」のフォルダ(SendTo フォルダ)を開きます。
  2. そのフォルダに先ほどの BAT ファイルを移動します。

f:id:shego:20171202163818p:plain

これで、 XLSX ファイルのアイコン右クリックからの「送る」にバッチが表示され、それを選択すれば media 画像フォルダが開きます。

f:id:shego:20171202163216p:plain

こうして取り出せる画像ファイルは貼り付け画像の元画像なので、 Excel 上でしたトリミングなどの編集結果は反映されていません。
また、オートシェイプなどの「図形」には、そもそも画像ファイルがありませんので取り出せません。

編集後の画像やオートシェイブもファイル保存したい場合には、それらをいったんコピーし、「形式を選択して貼り付け」で別の画像形式にする必要があります。

f:id:shego:20171203233637p:plain

「貼り付ける形式」にはブログに貼るキャプチャ画像などは「図(PNG)」や「図(GIF)」を選択します。
ネコ画像など写真系は「図(JPEG)」にします。
オートシェイプなどの図形も通常は「図(PNG)」でいいのですが、出版物や資料素材に使うなら「図(拡張メタファイル)」にしておくとデザイナーさんが喜ぶかもしれません。

 


画像ファイルを保存するマクロ

上記手順を参考に、画像ファイルを取り出すマクロを作成してみました。

本マクロはワークシート上の様々なオブジェクトを画像ファイルとして保存するものです。

下記 マクロ VBA を実行すると、ワークシート上の画像など選択されているオブジェクトが画像ファイルとして保存できます。

本マクロで対応するオブジェクトは、画面キャプチャや取り込み写真などの「画像」、オートシェイプなどの「図形」、「グラフ」、「SamrtArt」、「ワードアート」、そして選択された「セル範囲」です。

「画像」は XLSX 内の元画像ファイル(PNG、JEPG、GIFなど)をそのまま取り出します。
「セル範囲」は画質劣化なしの PNG として保存します。
そのほかは EMF 形式(拡張メタファイル)で保存します。

Option Explicit

Sub 画像をファイルに保存する()
    Dim selectionType As Variant
    selectionType = TypeName(Selection)
    Select Case selectionType
    Case "Picture", "ChartArea", "Range", "DrawingObjects"
        saveAsImage Selection, "export" & selectionType
    Case Else
        saveAsImage Selection, "exportDefault"
    End Select
End Sub

Private Sub saveAsImage(srcObject As Object, exportMethod As String)
On Error GoTo finalize:
    Const cTmpDir = 2
    Const cFileType = 2
   
    Dim fso As Object
    Dim shl As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set shl = CreateObject("Shell.Application")
        
    Dim tmpDir As Object
    Set tmpDir = fso.CreateFolder(fso.GetSpecialFolder(cTmpDir) & "\" & fso.GetTempName())
    
    Dim tmpBook As Workbook
    Dim imgObj As Shape
    Dim imgName As Variant
    
    Set tmpBook = Workbooks.Add
    'ActiveWindow.Visible = False
    
    Set imgObj = Application.Run(exportMethod, srcObject, tmpBook.ActiveSheet)
    If imgObj Is Nothing Then GoTo finalize
    
    imgName = imgObj.Name
    Set imgObj = Nothing
    
    tmpBook.Close SaveChanges:=True, FileName:=tmpDir.Path & "\image.xlsx"
    Set tmpBook = Nothing
    
    With shl.Namespace(tmpDir.Path)
        .ParseName("image.xlsx").Name = "image.zip"
        .CopyHere tmpDir.Path & "\image.zip\xl\media"
    End With
    
    Dim imgFile As Object
    Dim imgType, imgExt As Variant
    
    With shl.Namespace(tmpDir.Path & "\media")
        Set imgFile = .Items.Item(0)
        imgType = .GetDetailsOf(imgFile, cFileType)
        imgExt = LCase(fso.GetExtensionName(imgFile.Name))
    End With
    
    imgExt = IIf(imgExt = "tmp", "png", imgExt) ' Screenshot
    
    Dim saveFileName, fileFilter As Variant
    saveFileName = imgName & "." & imgExt
    fileFilter = imgType & " (*." & imgExt & "),." & imgExt
    
    saveFileName = Application.GetSaveAsFilename(saveFileName, fileFilter)
    If saveFileName <> False Then
        imgFile.Name = fso.GetFileName(saveFileName)
        shl.Namespace(fso.GetParentFolderName(saveFileName)).MoveHere imgFile
    End If
    
finalize:
    If Err <> 0 Then MsgBox TypeName(srcObject) & "の画像ファイル作成に失敗しました。" & vbCr & Err.Description, vbOKOnly + vbCritical
    If Not tmpBook Is Nothing Then tmpBook.Close SaveChanges:=False
    
    If fso.FolderExists(tmpDir) Then
        fso.DeleteFolder tmpDir
    End If
End Sub

Private Function exportPicture(pct As Picture, sht As Worksheet) As Shape
    pct.Copy
    sht.Paste
    Set exportPicture = sht.Shapes(1)
    exportPicture.Name = pct.Name
End Function

Private Function exportChartArea(cht As ChartArea, sht As Worksheet) As Shape
    cht.Copy
    sht.PasteSpecial Format:="図 (拡張メタファイル)"
    Set exportChartArea = sht.Shapes(1)
    exportChartArea.Name = cht.Name
End Function

Private Function exportRange(ByVal rng As Range, sht As Worksheet) As Shape
On Error GoTo failure
    rng.CopyPicture xlScreen, xlBitmap  ' PNG
    sht.Paste
    Set exportRange = sht.Shapes(1)
    exportRange.Name = rng.Worksheet.Name
    Exit Function
failure:
    MsgBox "選択セル範囲が大きすぎます", vbOKOnly + vbExclamation
End Function

Private Function exportDrawingObjects(drw As DrawingObjects, sht As Worksheet) As Shape
    drw.CopyPicture  ' EMF
    sht.Paste
    Set exportDrawingObjects = sht.Shapes(1)
    exportDrawingObjects.Name = "図形たち"
End Function

Private Function exportDefault(obj As Object, sht As Worksheet) As Shape
On Error GoTo failure:
    obj.CopyPicture     ' EMF
    sht.Paste
    Set exportDefault = sht.Shapes(1)
    exportDefault.Name = obj.Name
    Exit Function
failure:
    MsgBox TypeName(obj) & "には対応していません。", vbOKOnly + vbExclamation
End Function

【使い方】

  1. 上記 VBA プログラムを標準モジュールにコピペします
  2. ワークシート上にある、画像ファイルとして保存したいオブジェクトを選択します
  3. 本マクロを実行します
  4. ファイル保存ダイアログが表示されるので、保存先とファイル名を入力して「OK」を押します
  5. 画像ファイルが保存されます。

全てのオブジェクトが画像か保存できるわけではなく種類によっては失敗するのですが、全種類は試せていないので、やってみない箏には分かりません。 グラフの内部パーツ(棒グラフの棒など)は失敗する一方、フォームコントロール(ボタンなど)は平気なようです。

罫線を引いたセル範囲では、なぜか左と上の罫線が抜けます。罫線を引いた表びったりではなく、余白となるセルを周りに含めるような範囲選択をしてください。

セル範囲で画像化されるのは、セルの内容だけでなく、その上に置かれた画像やオートシェイプなどもキャプチャされます。 応用として、図形やグラフは EMF 形式ですが、その背景となるセル範囲の方を選択すると PNG 形式で保存できます。

【注意】 本マクロは ファイル操作を行うマクロ です。そのような Excel マクロの実行は使用者の所属組織のセキュリティポリシーに抵触している可能性があります。あくま個人的な責任の範囲内でご利用にとどめてください。

【注意】 本マクロの VBA プログラムは、Micorsoft 社が推奨しない機能を利用しています。そのため実行する環境や将来の Windows や Excel のバージョンによっては、動作しない、または突然動作しなくなる可能性がありますので、あらかじめご承知おきください。

まとめ

Excelには、付け画像をファイルとして保存する機能はありません。
Excel ファイルの拡張子を「.zip」に変更することで、XLSX 内部の元画像ファイルを取り出すことができます。
それをするバッチファイルとマクロを作成しました。

本記事の内容は Windows 10 の Excel 2013 で動作確認しました。