DuKiccoの雑記

My Life Is Myself

【シート上の画像をファイルとして保存する】【エクセル2013,VBA】

VBAを使わないでシート上の画像をファイルとして保存する方法

Excelで表や挿入した図形を画像として保存する

Excel シートに貼り付けた画像をファイルとして保存するには

 

VBAを使ってシート上の画像をファイルとして保存する方法

下に記したやり方だと画質が落ちる気がするので、上記の方法を使えるなら上記の方法がよい気がする。

画像をいきなりファイルとして保存することはできない様子。だがグラフであればエクスポートにより画像として保存するメソッドがあるのでこれを利用する。つまりは空のグラフをつくり、その中に画像を表示しエクスポートすることでシート上の画像をファイルとして保存できる。

Excel/VBAクリニック,今月の診断 - 第37回 グラフを画像ファイルに保存する:ITpro

 

以下シート上の全画像をファイルとして保存するコード。ファイルはデスクトップにオブジェクト名で保存される。

 

============================================================

Sub 保存()

'ワークシートの全オブジェクトをループ
For Each tobj In ActiveSheet.Shapes


If tobj.Type = 13 Then'オブジェクトが画像ならType=13となる。
tobj.CopyPicture
Fname = tobj.Name'オブジェクトの名前を取得
ACWidth = tobj.Width'オブジェクトのサイズを取得(高さ)

ACHeight = tobj.Height'オブジェクトのサイズを取得(高さ)

 

'オブジェクトとほぼ同サイズの空のグラフを一時的に作る

Set TCht = ActiveSheet.ChartObjects.Add(0, 0, ACWidth * 0.8, ACHeight * 0.8).Chart

TCht.Paste’グラフに画像をペーストする。

’エクスポート先はデスクトップ。ファイル名はオブジェクト名。タイプはJPG(書き換えればpng等でもいける。)

TCht.Export Filename:=myDeskTopPath &  Fname & ".jpg", filtername:="JPG"
TCht.Parent.Delete’グラフを削除する。
End If
Next

End Sub

Function myDeskTopPath()
' デスクトップパスの取得
Dim MyWSH As Object
Set MyWSH = CreateObject("WScript.Shell")
myDeskTopPath = MyWSH.SpecialFolders("Desktop")
Set MyWSH = Nothing
End Function