Excelシートの一部をピクチャーにして画像として保存する方法

Excelシートの内容をピクチャーにしてどこかに保存しておきたいといったことがまれにあります．その方法．

【用例】
Sub figure_save()

'パス名取得
Sheets("figure").Select
Cells.Select
With Selection.Font
.Name = "ＭＳ Ｐゴシック"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Cells.EntireColumn.AutoFit
Cells(1, 1).Select
'最終行のチェック
Sheets("figure").Select
Range("B1").Select
Selection.End(xlDown).Select
encel2 = ActiveCell.Address
cend2 = Mid(encel2, 4)
Cells(1, 1).Select
'表全体の選択
Range(Cells(1, 1), Cells(cend2, 5)).Select
'表を図としてコピー貼り付け
Selection.Copy
ActiveSheet.Pictures.Paste.Select
ActiveSheet.Pictures.ShapeRange.Name = "pic1"
'グラフのサイズを取得
ActiveSheet.Shapes("pic1").Select
hei = Selection.ShapeRange.Height
wid = Selection.ShapeRange.Width
Selection.Copy
'チャ−ト枠作成しチャートオブジェクトとして貼り付ける
Set grf = ActiveSheet.ChartObjects.Add(0, 0, wid + 8, hei + 8).Chart
grf.Paste
ggg1 = grf.Name
ggg2 = Mid(ggg1, InStr(1, ggg1, "グ", 1))

'枠線なし
ActiveSheet.ChartObjects(ggg2).Activate
ActiveChart.ChartArea.Select
Selection.Border.LineStyle = 0
'このファイルのありかを調べる
phn = ActiveWorkbook.Path
If phn = "" Then
MsgBox "ブックを1度保存してから実行して下さい"
Exit Sub
End If

'gif保存
gifname = "figure1.jpg"
grf.Export phn & "¥trend_graph¥" & gifname

'仮作成の図形削除
grf.Parent.Delete
Range("A1").Select
'ピクチャーの削除
ActiveSheet.Shapes("pic1").Select
Selection.Delete

Range("A1").Select

End Sub

【解説】

とりあえず追々ということで…