求教我哪里写错了

睡不着了qwe · 发表于 2023-2-13 17:29

导出图片并重命名  我写的导不出来
Sub Rename()
Application.ScreenUpdating = False
On Error Resume Next
MkDir ThisWorkbook.Path & "\图片"
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 '创建图片
            .Parent.Select
            .Paste
            .Export ThisWorkbook.Path & "\图片\" & RN & ".jpg"
            .Parent.Delete
         End With
      End If
Next
MsgBox "导出图片完成！"
Application.ScreenUpdating = True
End Sub

文件.zip (297.32 KB, 下载次数: 4)

MOY838840554 · 发表于 2023-2-13 22:25

截图粘贴进去的图片类型是msoAutoShape，不是msoPicture
插入的图片才是msoPicture类型

mmwwdd · 发表于 2023-2-14 09:00

MOY838840554 发表于 2023-2-13 22:25
截图粘贴进去的图片类型是msoAutoShape，不是msoPicture
插入的图片才是msoPicture类型

很好,我也是头一次知道

		自动登录	找回密码
密码			免费注册

[求助] 求教 我哪里写错了

[求助] 求教我哪里写错了