求助：VBA代码哪里有问题。

weixin_47875022 2025-01-27 09:10:28

各位老大

大家好。

我想把EXCEL单元格里的图片批量导出来，并且以人名来命名，写完的代码哪里有问题，拜托大家指导一下。

感谢。

Sub Rename()

Application.ScreenUpdating = False

On Error Resume Next

MkDir ThisWorkbook.Path & "\pho"

For Each pic In ActiveSheet.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

.Parent.Select

.Paste

.Export ThisWorkbook.Path & "\pho" & rn & ".jpg"

.Parent.Delete

End With

End If

MsgBox "导出图片完成！"

Application.ScreenUpdating = True

End Sub

...全文

99 2 打赏收藏转发到动态举报

写回复

用AI写文章

2 条回复

切换为时间正序

请发表友善的回复…

发表回复

渡老 02-04

打赏
举报

Sub Rename()

Application.ScreenUpdating = False

On Error GoTo ErrorHandler

MkDir ThisWorkbook.Path & "\pho\"

For Each pic In ActiveSheet.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
            .Parent.Select
            .Paste
            .Export ThisWorkbook.Path & "\pho\" & rn & ".jpg"
            .Parent.Delete
        End With
    End If
Next

MsgBox "导出图片完成！"

Application.ScreenUpdating = True
Exit Sub