利用VBA宏批量解决Word中图片大小、居中设置

需求：经常阅读网上的研报（没钱买排版漂亮的高质量研报），有些需要保存的复制下来到word里，图片很大都超出word的边界了，也没有居中，手工一张张调整不现实，上百页的研报，几十张图片。

解决方案：利用VBA宏批量解决。第一种方法经过测试，只是前面部分有些，后面部分无效，不知道何解。

以下是代码：

Sub setpicsize() '设置图片尺寸

'第一种方法，经测试，文档前面部分图片有效，后面部分无效
    'Dim n '图片个数
    'On Error Resume Next '忽略错误
    'For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes 类型 图片
    'ActiveDocument.InlineShapes(n).Height = 198.45 '设置图片高度为 7cm
    'ActiveDocument.InlineShapes(n).Width = 455 '单位是像素，设置图片宽度 16cm
    'Next n
 
 
'第二种方法，经测试，对整篇文档图片有效
    Dim Shap As InlineShape
    For Each Shap In ActiveDocument.InlineShapes
        If Shap.Type = wdInlineShapePicture Then
            Shap.LockAspectRatio = msoTrue '锁定纵横比，防止默认没有锁定修改了图片变形；不锁定纵横比是msoFalse
            'MsgBox "图片宽度" & Shap.Width'测试，提示图片大小以便判断单位
            
            If Shap.Width > 485 Then '此处单位是像素；如果图片超出边界才进行处理，否则图片放大看起来不好看。
                'Word中的尺寸单位默认是cm（厘米），而1cm等于28.35px（像素），由于代码中换算设置的单位是px（像素）。所以就用尺寸高度或宽度值乘像素值。即为：7*28.35=198.45；宽度换算方法与此相同。
                Shap.Width = CentimetersToPoints(17) '此处单位是厘米。如果Word设置页边距为适中，则中间内容宽17.08CM
                'Shap.Height = CentimetersToPoints(7) '高度不设置，默认锁定纵横比
            End If
            
            '设置图片居中
            Shap.Range.Select
            Selection.ClearFormatting '如果Word中图片设置了行距不是1，比如固定值30磅，则无论图片设置什么格式，嵌入式会造成只显示一部分图片。
            Selection.Range.Paragraphs.Alignment = wdAlignParagraphCenter

        End If

    Next

End Sub

利用VBA宏批量解决Word中图片大小、居中设置

猜你喜欢