Excel 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