選択範囲をJPEG画像形式で保存するVBA：Excel

Option Explicit

'ファイル保存ダイアログ
Private Function GetSaveFileName() As String
    Dim sfile As String

    sfile = Application.GetSaveAsFilename(fileFilter:="JPGファイル (*.jpg), *.jpg")
    If sfile = "False" Then
        GetSaveFileName = ""
    Else
        GetSaveFileName = sfile
    End If
End Function

Private Sub CommandButton1_Click()
    Dim rg As Range
    Dim cht As Chart
    Dim fina As String
    
    '保存ファイル名を取得
    fina = GetSaveFileName
    
    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