Word2013批量修改图片尺寸

最新推荐文章于 2024-09-23 08:14:35 发布

counsellor

最新推荐文章于 2024-09-23 08:14:35 发布

阅读量2.2k

点赞数 1

分类专栏：日常小问题文章标签： word

本文链接：https://blog.csdn.net/counsellor/article/details/98600129

版权

日常小问题专栏收录该内容

15 篇文章 0 订阅

订阅专栏

0x00 前言

保持图片原始比例(锁定横纵比例)的情况下，批量调整为适应页面尺寸的图片大小。

名词

LockAspectRatio - 锁定横纵比例， MsoTrue if the specified shape retains its original proportions when you resize it. MsoFalse if you can change the height and width of the shape independently of one another when you resize it. Read/write MsoTriState.

wdInlineShapeLinkedPicture - 嵌入式连接图片(一般浏览器复制过来的图片类型)

wdInlineShapePicture - 嵌入式图片

0x01 使用宏

P.S. 2019.8.8 更新代码
代码如下：

Sub ResizePhotos()
Dim Shap As InlineShape
Dim maxWith
maxWith = CentimetersToPoints(16.79)

For Each Shap In ActiveDocument.InlineShapes

    Debug.Print Shap.Type; "Shap.Type"; wdInlineShapePicture

    If (Shap.Type = wdInlineShapeLinkedPicture) Or (Shap.Type = wdInlineShapePicture) Then

        If Shap.Width > maxWith Then
 
            ' Shap.LockAspectRatio = msoTrue
            Debug.Print "before width: "; Shap.Width
           Debug.Print "before Height: "; Shap.Height
           oW = Shap.Width
           oH = Shap.Height
           aspect = oH / oW 'aspect ratio
           nH = aspect * CentimetersToPoints(16.79) 'new width
           Shap.Width = CentimetersToPoints(16.79)
           Shap.Height = nH
           Debug.Print "after width: "; Shap.Width
           Debug.Print "after Height: "; Shap.Height

        End If
    End If

Next

End Sub