Excel VBA-批量导出图片.vba

'r,c 图片所在单元格的偏移量，用来做图片的名字
Sub exportPic()
r = 0
c = -2
    For i = 1 To ActiveSheet.Shapes.Count
        ActiveSheet.Shapes(i).Select
        Name = Range(ActiveSheet.Shapes(i).TopLeftCell.Address).Offset(r, c)
        H = Selection.Height
        W = Selection.Width
        Selection.ShapeRange.ScaleHeight 1#, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleWidth 1#, msoFalse, msoScaleFromTopLeft
        Selection.CopyPicture
       
        Set myChart = ActiveSheet.ChartObjects.Add(0, 0, Selection.Width - 2, Selection.Height - 2).Chart
        myChart.Paste
        ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Line.Visible = msoFalse '去掉Chart边框
        ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Fill.Visible = msoFalse '去掉Chart填充
        myChart.Export ThisWorkbook.Path & "\" & Name & ".png"
        myChart.Parent.Delete
    
        ActiveSheet.Shapes(i).Select
        Selection.Height = H
        Selection.Width = W
    Next
End Sub