首页 > 编程语言 > 详细

VBA批量导出图片并重命名

时间:2021-03-27 09:07:10      阅读:51      评论:0      收藏:0      [点我收藏+]

 


Private Sub 导出图片_Click()

Application.ScreenUpdating = False
On Error Resume Next
MkDir ThisWorkbook.Path & "\图片"

ActiveSheet.Shapes
For Each PIC In Shapes

If PIC.Type = msoPicture Then
RN = PIC.TopLeftCell.Offset(0, 4).Value ‘重命名图片,图片和编号之间的距离是4格,编号如果在图片前面则为(0,-4)

PIC.Width = 800   ‘先放大图片宽800px,自行调整
PIC.Height = 800  ‘高800px
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
PIC.Width = 100 ‘导出后缩小图片宽为100PX
PIC.Height = 100 ‘高100PX


Next
MsgBox "导出图片完成!"
Application.ScreenUpdating = True
End Sub

 

VBA批量导出图片并重命名

原文:https://www.cnblogs.com/lmh6825/p/14584703.html

(0)
(0)
   
举报
评论 一句话评论(0
关于我们 - 联系我们 - 留言反馈 - 联系我们:wmxa8@hotmail.com
© 2014 bubuko.com 版权所有
打开技术之扣,分享程序人生!