如何按指定名称快速导出Excel中的图片？

照例举个例子。如下图所示，工作表中存在多张图片，现在需要将其导出，并按图片向左偏移一个单元格，也就是A列单元格的值进行命名。

导出后结果如下图所示：

如果不追求规范图片命名，只是导出Excel中的图片，倒不用VBA代码。将工作簿后缀名修改为rar，双击打开，依次点击xl→media即可。

但如果需要规范图片名称，就优先推荐VBA代码了。参考代码如下：

代码复制运行即可

看不全可以左右拖动..▼

Sub ExportPic()    Dim strPath As String, strPicName As String, strWhere As String, strPicFullName As String    Dim shp As Shape, k As Long, d As Object, x As String, y As Long    With Application.FileDialog(msoFileDialogFolderPicker)       If .Show Then strPath = .SelectedItems(1) Else: Exit Sub    End With    strWhere = InputBox("请输入图片名称相对图片所在单元格的偏移位置，例如上1、下1、左1、右1", , "左1") '用户输入图片相对单元格的偏移位置。    If Len(strWhere) = 0 Then Exit Sub    x = Left(strWhere, 1) '偏移的方向    If InStr("上下左右", x) = 0 Then MsgBox "你未输入偏移方位。": Exit Sub    y = Val(Mid(strWhere, 2)) '偏移的值    Set d = CreateObject("scripting.dictionary")    Application.ScreenUpdating = False    For Each shp In ActiveSheet.Shapes        If shp.Type = msoPicture Then            strPicName = GetPicName(x, y, shp.TopLeftCell)            If Not d.exists(strPicName) Then                d(strPicName) = 1            Else                d(strPicName) = d(strPicName) + 1                strPicName = strPicName & d(strPicName)            End If            strPicFullName = strPath & "\" & strPicName & ".jpg"            shp.Copy            With ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height).Chart                .Parent.Select                .Paste                .Export strPicFullName, "jpg"                .Parent.Delete            End With        End If    Next    Application.ScreenUpdating = True    MsgBox "导出图片完成！" & Chr(13) & "路径：" & strPath, , "提示"End Sub
Function GetPicName(x As String, y As Long, rngShape As Range) As String    Dim strPicName As String    Select Case x        Case "上"        strPicName = rngShape.Offset(-y, 0).Value        Case "下"        strPicName = rngShape.Offset(y, 0)        Case "左"        strPicName = rngShape.Offset(0, -y)        Case "右"        strPicName = rngShape.Offset(0, y)    End Select    GetPicName = IIf(strPicName = "", "图片", strPicName)End Function