Sub ExportSheetPictures()
    Dim shp, my_sheet
    Set my_sheet = Sheets("Sheet0")
    ' 循环获取工作表中的shape对象
    For Each shp In my_sheet.Shapes
        shp.Copy
        ' 新建空白chart对象,将shape对象复制粘贴到chart对象中
        With my_sheet.ChartObjects.Add(0, 0, shp.Width, shp.Height + 5).Chart
            .ChartArea.Border.LineStyle = 0
            .ChartArea.Select
            .Paste
            .Export ThisWorkbook.Path & "/pic/" & Range("Q" & shp.TopLeftCell.Row) & ".png"
            .Parent.Delete
        End With
    Next
    Set my_sheet = Nothing
End Sub
	更多精彩内容:各种AI课程、技能课程、黑科技软件、网站小程序源码、副业小项目、PPT模板等精品素材、电商课程、推广引流课程等,尽在 天边资源网 。