今天有朋友问我如何处理Word中大量图片的缩放问题,于是就在网上找了一些相关的资料,修改后写出了如下VBS
主要功能是批量缩放Word文档中图片,把所有图片按原高宽比缩放到A4纸的工作宽度大小(小图片也会被放大)
如果不需要处理小图片,可以加 If 判断,只处理所有宽度大于420的图片即可
Sub setpicsize() '批量缩放Word图片
Dim n '图片个数
Dim picwidth '图片宽度
Dim picheight '图片高度
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
picheight = ActiveDocument.InlineShapes(n).Height '获取图片高度(像素值)
picwidth = ActiveDocument.InlineShapes(n).Width '获取图片宽度(像素值)
'设置宽度适合文档大小
'(420/picwidth)为缩放比例
'其中,420为Word中A4纸默认工作宽度(估计值。。。)
ActiveDocument.InlineShapes(n).Width = picwidth * (420 / picwidth) '缩放宽度
ActiveDocument.InlineShapes(n).Height = picheight * (420 / picwidth) '同比例缩放高度
Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
picheight = ActiveDocument.Shapes(n).Height
picwidth = ActiveDocument.Shapes(n).Width
ActiveDocument.Shapes(n).Width = picwidth * (420 / picwidth) '同上
ActiveDocument.Shapes(n).Height = picheight * (420 / picwidth) '同上
Next n
End Sub