Sub ki596()
Dim grf As Chart
Dim scel As Range

'保存先パス
phn = ActiveWorkbook.Path
     If phn = "" Then
         MsgBox "このブックと同じフォルダ−へGIFを保存します" & Chr(10) _
        & "パス未定の為ブックを1度保存してから実行して下さい"
        Exit Sub
     End If

'コピ−個所指定
    msg = "GIFで保存するセル範囲を指定して下さい。" & Chr(10) _
    & "(セル範囲をシ−トから指定して下さい)"
    On Error Resume Next
    Application.DisplayAlerts = False
    Set scel = Application.InputBox(msg, "セル指定", Type:=8)
    Application.DisplayAlerts = True
    If TypeName(scel) = "Nothing" Then
        MsgBox "セル範囲をシ−トから指定して下さい"
        Exit Sub
    End If
    On Error GoTo 0
    scel.Select
'画像コピ−
  Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
  ActiveSheet.Paste
  ActiveSheet.Pictures.Select
  pnam2 = Selection.Name
        
  ActiveSheet.Shapes(pnam2).Select
    hei = Selection.ShapeRange.Height
    wid = Selection.ShapeRange.Width
'チャ−ト枠作成
  Set grf = ActiveSheet.ChartObjects.Add(0, 0, wid + 8, hei + 8).Chart
  grf.Paste

'gif保存
   grf.Export phn & "\" & "Mygif.gif"
'仮作成の図形削除
   grf.Parent.Delete
   ActiveSheet.Shapes(pnam2).Select
   Selection.Delete
     
  Range("A1").Select
End Sub