Sub グラフのキャプチャ画像を保存する()
'画像の保存場所とファイル名を指定する
保存パス = ThisWorkbook.Path & "\" & "グラフ.png"
'[参照設定]Microsoft Forms x.x Object Library にチェックを入れる
Set 画像処理 = CreateObject("new: {1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
'画像の範囲を指定する
Set 画像範囲 = ActiveSheet.Shapes("グラフの名前")
'画像範囲をコピーする
画像範囲.CopyPicture
'セルA1に貼付後、画像処理するためA1へ画面移動する、移動しないと正常処理不可
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
'まず空白画像枠をA1に貼り付ける
Set 画像 = ActiveSheet.ChartObjects.Add(0, 0, 画像範囲.Width, 画像範囲.Height)
'まず空白画像を保存する
画像.Chart.Export 保存パス
'まず画像ファイルサイズを取得する
元画像Size = FileLen(保存パス)
'[後画像Size]が[元画像Size]より大きくなるまで処理を続ける
Do
'画像を貼り付ける
画像.Chart.Paste
'画像を保存する
画像.Chart.Export 保存パス
'処理完了を待つ
DoEvents
'貼り付け後の画像サイズを取得する
後画像Size = FileLen(保存パス)
'空白でなければ[後画像Size]が[元画像Size]より大きくなるのでLoop終了
Loop Until 後画像Size > 元画像Size
画像.Delete
Set 画像 = Nothing
End Sub
キャプチャ画像の貼り付けは1回では完了しないことが多く、場合によっては10回以上
処理がされるため、正常に貼り付けられたらLoopを終了するという珍しい仕様です。