今回は、シートに貼り付けた画像をファイルに保存する方法について調べます。
また、それを自動化するマクロを作成します。
貼り付け画像をファイルに保存できない
Excelシートには画像も貼り付けられるので、スクラップブック的な使い方もあります。
パソコン関連のブログなど書いていると、ウィンドウ画面のキャプチャ画像を沢山取るわけですが、それらを Excel シートに貼ってまとめておいたりします。 Excel には正にそのための「スナップショット」というおベンリ機能があって重宝します。
しかし、せっかく集めたのキャプチャを画像ファイルとして書き出す機能がありません。 仕方ないので、いったん「ペイント」にコピー＆ペーストして画像ファイルに保存するのですが、これがまた使えないソフトです。
ペイントはウィンドウを一つしか開けないので、画像の余白をギリギリまでトリミングしなおしたり、ファイル名変更前に Ctrl+S して前の画像を上書き保存してしまったりで、「余計な仕事をやらされている感」が募ります。
Word や PowerPoint なら「図として保存」で画像をファイルに保存できるのに、Excel にそれが無いのは一体何の嫌がらせでしょうか。
Microsoft 365 で「図として保存」する
ついに Microsoft 365 版 Excel で「図として保存」がサポートされました！
Microsoft 365 版 Excel をお使いの方は、本記事を忘れて以下の記事を参照してください。
Excel ファイルから画像と取り出してみる
調べた限り、Excel の機能を使って画像を保存する方法はなさそうです。
その代わり、Window 側から Excel ファイル（XLSX）の中にある画像を取り出す方法が知られています。
XLSX ファイルの実体は ZIP 書庫なので、その拡張子を「.zip」に変更すれば、普通にWindows エクスプローラで中身を開くことができます。 その中を探すと貼り付け画像のファイルが PNG やら JPEG やらで見つかります。
拡張子というのは、ファイルの種類を区別するために付加する、ファイル名の最後の部分のことです。 Excel ブックなら「 .xlsx 」、PNG 画像なら「.png」、ZIP 書庫なら「.zip」というようにファイルタイプで決まっています。
ではお目当ての Excel ファイルの拡張子を変更してみましょう。
はい、ありませんね、拡張子。
ファイル名の拡張子はふだん隠されていて、これを表示させるには自分で Windows の設定をする必要があります。 Windows のバージョンによって違うのですが、 Windows 10 ならフォルダの「表示」タブにある「拡張子を表示する」チェックボックスがそれです。
拡張子が表示されたら、 Excel ファイルをコピーした上で、コピーの方のファイル名を編集（F2）して、「.zip」を最後に追加します。（必ずファイルをコピーをしてください）
そうすると、アイコンも ZIP に変わり、ZIPファイルとして普通に開いたり解凍できるようになります。 その中にある、xl¥media というフォルダに貼り付け画像が保存されています。
各ファイルが image1.png のような連番になっていて、ZIP 内ではプレビューアイコンも表示されないので、沢山あるとどれがどの画像だかわかりません。media フォルダごと ZIP の外に移動すればプレビューアイコンで確認できます。
拡張子が「.tmp」となっているファイルは、Excelの「スナップショット」機能を使って貼り付けた画像で、実体は PNG 画像なので拡張子を「.png」に変えてください。
まあ、これで画像は取り出せました。
ただ、難しい作業ではないとはいえ、働かされている感は拭えませんね。
なのでこういう操作はバッチで自動化してしまいましょう。
XLSX ファイルの画像フォルダを開くバッチ
if "%~x1"==".xlsx" ( copy %1 %1.zip start "" "%~f1.zip\xl\media" )
【作業手順】
- 上記バッチプログラムをテキストエディタ（メモ帳など）にコピー＆ペーストします
- それに適当なファイル名をつけて バッチファイル（BAT ファイル）としてデスクトップなどに保存します
- 拡張子を「.bat」にします。
- 画像を取り出したい XLSX ファイルのアイコンを、そのバッチファイルのアイコンにドラッグ＆ドロップします。
- XLSX ファイルが ZIP ファイルとしてコピーされ、画像フォルダが自動的に開きます
- エラーダイアログが出たら、XLSX ファイルに貼り付け画像が１枚も無いということです
- 画像ファイルを取り出し、 残りガラの ZIP ファイルは削除します。
だいぶ便利になりました。
ただ、使ってみると今度は、ドラッグ＆ドロップをするのにデスクトップまで戻るのが意外と手間に感じます。
これをコンテキストメニューの「送る」に追加しておけばもう少し快適になるでしょう。
- フォルダのアドレスバーに「
shell:sendto」と入力して「送る」のフォルダ（SendTo フォルダ）を開きます。 - そのフォルダに先ほどの BAT ファイルを移動します。
これで、 XLSX ファイルのアイコン右クリックからの「送る」メニューにバッチが表示され、それを選択すれば media 画像フォルダを開くことができます。
こうして取り出せる画像ファイルは、貼り付け画像の元画像なので、 Excel 上でしたトリミングなどの編集結果は反映されていません。 また、オートシェイプなどの「図形」には、そもそも画像ファイルがありませんので取り出せません。
編集後の画像やオートシェイブもファイル保存したい場合には、それらをいったんコピーし、「形式を選択して貼り付け」で別の画像形式にする必要があります。
「貼り付ける形式」にはブログに貼り付ける画面キャプチャなどは「図（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
【使い方】
- 上記 VBA プログラムを標準モジュールにコピペします
- ワークシート上にある、画像ファイルとして保存したいオブジェクトを選択します
- 本マクロを実行します
- ファイル保存ダイアログが表示されるので、保存先とファイル名を入力して「OK」を押します
- 画像ファイルが保存されます。
画像のトリミングについて
- キャプチャ画像などを Excel の画像編集機能でトリミングした状態で保存したい場合には、事前に画像の圧縮をしてください。 「図ツール/書式」から「図の圧縮」を実行します。
セル範囲の罫線について
- 罫線を引いたセル範囲では、なぜか左と上の罫線が抜けます。罫線を引いた表びったりではなく、余白となるセルを周りに含めるような範囲選択をしてください。
図形やグラフの画像形式について
- 図形やグラフは EMF 形式になりますが、画面イメージのままの PNG 形式として保存したい場合には、その背景となるセル範囲を選択して本マクロを実行してください。
フォームコントロール（ボタンなど）も画像保存出来るようですが、なんでもできるわけではなく、グラフの内部パーツ（棒グラフの棒など）は失敗します。
【注意】 本マクロは ファイル操作を行うマクロ です。そのような Excel マクロの実行は使用者の所属組織のセキュリティポリシーに抵触している可能性があります。あくま個人的な責任の範囲内でご利用にとどめてください。
【注意】 本マクロの VBA プログラムは、Micorsoft 社が推奨しない機能を利用しています。そのため実行する環境や将来の Windows や Excel のバージョンによっては、動作しない、または突然動作しなくなる可能性がありますので、あらかじめご承知おきください。
まとめ
Excelには、付け画像をファイルとして保存する機能はありません。
Excel ファイルの拡張子を「.zip」に変更することで、XLSX ファイル内部の元画像ファイルを取り出すことができます。
それをするバッチファイルとマクロを作成しました。
本記事の内容は Windows 10 の Excel 2013 で動作確認しました。
