学步园

今天有朋友问我如何处理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