Sub nnn()
    Dim pic As Shape
    Dim nm$
    Dim m As Double
    Dim a As Chart
    Dim k As Long
    k = 8
    If Cells(2, 5) <> "" Then
        m = Cells(2, 5)
    Else
        m = 1
    End If
'-----------------------
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With ActiveSheet
        For Each pic In .Shapes
            If pic.Type = 3 Or pic.Type = 6 Then
                k = k + 1
                pic.Copy
                nm = ThisWorkbook.Path & "\" & pic.Name & ".jpg"
                With .ChartObjects.Add(0, 0, pic.Width, pic.Height).Chart
                    .ChartArea.Border.LineStyle = 0
                    .Parent.Select
                    .Paste
                    '''''''''''
                    .ChartArea.Height = .PlotArea.Height * m
                    .ChartArea.Width = .PlotArea.Width * m
                    
                    Cells(k, 2) = pic.Name
                    Cells(k, 3) = .ChartArea.Width
                    Cells(k, 4) = .ChartArea.Height
                    '''''''''''
                    .Export Filename:=nm, FilterName:="JPG"
                    .Parent.Delete
                End With
            End If
        Next
    End With
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Beep
End Sub