Sub セル範囲のキャプチャ画像を保存する()

    '画像の保存場所とファイル名を指定する
    保存パス = ThisWorkbook.Path & "\" & "テスト.png"
    
    '[参照設定]Microsoft Forms x.x Object Library にチェックを入れる
    Set 画像処理 = CreateObject("new: {1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    
    '画像の範囲を指定する
    Set 画像範囲 = Range("C4:D6")
    '画像範囲をコピーする
    画像範囲.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