Save pictures out as file?

Sub Test()
'   Change to suit
    Const Folder As String = "C:\Pictures\"
    Dim Pic As Picture
    Dim ShTemp As Worksheet
    Dim ChTemp As Chart
    Dim PicTemp As Picture
    Application.ScreenUpdating = False
    For Each Pic In ActiveSheet.Pictures
        Set ShTemp = Worksheets.Add
        Charts.Add
        ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name
        With Selection.Border
            .Weight = 2
            .LineStyle = 0
        End With
        Set ChTemp = ActiveChart
        Pic.Copy
        ChTemp.Paste
        Set PicTemp = Selection
        With ChTemp.Parent
            .Width = PicTemp.Width + 8
            .Height = PicTemp.Height + 8
        End With
        ChTemp.Export Filename:=Folder & Pic.Name & ".jpg", FilterName:="jpg"
        Application.DisplayAlerts = False
        ShTemp.Delete
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
    Next Pic
End Sub