Sub CopyChartToPictureFiles()
    Dim ch As ChartObject, n
    Dim gr As New BSGraphic
    For Each ch In ActiveSheet.ChartObjects
        n = n + 1
        'Debug.Print ch.Name
        ch.CopyPicture xlScreen, xlBitmap
        gr.LoadFromClipboard
        gr.SaveToFile ThisWorkbook.Path & "\charts\Chart" & n & ".bmp"
        gr.FreeClipboard
        
    Next
    MsgBox "Count files: " & n
    Set gr = Nothing
End Sub
