If fina <> "" Then
'選択範囲を取得
Set rg = Selection
'選択した範囲を画像形式でコピー
rg.CopyPicture appearance:=xlScreen, Format:=xlPicture
'画像貼り付け用の埋め込みグラフを作成
Set cht = ActiveSheet.ChartObjects.Add(0, 0, rg.Width, rg.Height).Chart
'埋め込みグラフに貼り付ける
cht.Paste
'JPEG形式で保存
cht.Export Filename:=fina, filtername:="JPG"
'埋め込みグラフを削除
cht.Parent.Delete
End If
End Sub