批量保存表格中的图片并命名

Sub 导出工作表中的图片()
    '-----------------------------------------------------------------------
    '自定义数据类型
    Dim path As String
    Dim Shp, Sht
    Dim n As Long
    
    Application.ScreenUpdating = False
    
    '在当前路径下增加一个文件夹，名称为“导出图片”，赋值给path
    path = ThisWorkbook.path & "\导出图片\"
    
    '在当前路径是否存在文件夹，存在则清空，不存在则新建
    If Len(Dir(path, vbDirectory)) Then
        Kill (path & "*")
        GoTo A:
    Else
        MkDir (path)
        GoTo A:
    End If


'便利工作薄的每个工作表，如果表中存在图片，则导出
A:
    For Each Sht In ThisWorkbook.Sheets
        Sht.Activate
        If ActiveSheet.Shapes.Count > 0 Then
            n = 0
            For Each Shp In ActiveSheet.Shapes
                    n = n + 1
                    Shp.Copy
                    '创建新的嵌入式图表，保存到当前路径的新建文件夹中
                    With ActiveSheet.ChartObjects.Add(0, 0, Shp.Width, Shp.Height).Chart
                        .Paste
                        .Export path & Sht.Name & "-" & Shp.Name & ".jpg"
                        .Parent.Delete
                    End With
            Next
        End If
    Next Sht
    Application.ScreenUpdating = True
MsgBox "导出完成"
End Sub

1：对表格中的图片批量汇出

2：自主修改部分代码做成小的应用

3：模板代码可以将保存后的图片按照对应的某列值、或者原图片名称命名

源码视频演示

批量保存表格中的图片并命名

目录