Excel VBA-批量导出图片.vba

'r,c 图片所在单元格的偏移量，用来做图片的名字Sub exportPic()r = 0c = -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 NextEnd Sub