求助！如何批量导出有对应名称的图片

changhong8

效果如下图

luckyying

changhong8 发表于 2019-7-8 22:38
代码如下

非常感谢老师！！！

kaili1223

changhong8 发表于 2019-7-8 22:38
代码如下

代码怎么没显示？麻烦再发一遍可以吗

嬲你

Sub Export_Picture() '图片批量导出保存并重命名某一列数据为图片文件名
Application.ScreenUpdating = False
On Error Resume Next
MkDir ThisWorkbook.Path & "\images"
For Each Pic In Shapes
If Pic.Type = msoPicture Then
RN = Pic.TopLeftCell.Offset(0, -1).Value '重命名图片
Pic.Copy
With ActiveSheet.ChartObjects.Add(0, 0, Pic.Width, Pic.Height).Chart '创建图片
.Paste
.Export ThisWorkbook.Path & "\images\" & RN & ".jpg"
.Parent.Delete
End With
End If
Next
'MsgBox "Exporting the picture is complete!" '导出图片完成！
Application.ScreenUpdating = True
Shell "explorer.exe " & ThisWorkbook.Path & "\images\", vbNormalFocus '打开文件夹！
End Sub