WORD中VBA编程设置图片大小

hnzlf

在WPS 2019 中发何在word文档添加一浮动按钮来用VBA设置当前选中图片的大小？

cayuer

前期准备
在 WPS 2019 中，点击 “文件” 菜单，选择 “选项”。在弹出的 “选项” 窗口中，选择 “自定义功能区”，勾选 “开发工具”，点击 “确定”，以启用开发者工具。
编写 VBA 代码
点击 “开发工具” 选项卡，选择 “宏”，输入宏名称，比如 “ResizeSelectedPicture”，点击 “创建”。
在打开的 VBA 编辑器中，输入以下代码：
vba
Sub ResizeSelectedPicture()
    Dim shp As InlineShape
    If Selection.InlineShapes.Count > 0 Then
        Set shp = Selection.InlineShapes(1)
        shp.LockAspectRatio = msoFalse '解除纵横比锁定
        shp.Width = CentimetersToPoints(5) '设置宽度为5厘米，可根据需要修改
        shp.Height = CentimetersToPoints(3) '设置高度为3厘米，可根据需要修改
    End If
End Sub

上述代码中，首先判断当前选中区域是否有嵌入型图片，如果有，则解除图片的纵横比锁定，并设置其宽度和高度。你可以根据实际需求修改宽度和高度的值。
添加浮动按钮
在 Word 文档中，点击 “开发工具” 选项卡，然后点击 “插入”，选择 “形状”，从下拉列表中选择一个合适的形状，比如 “矩形”，绘制一个矩形作为浮动按钮。
绘制好矩形后，右键点击矩形，选择 “指定宏”，在弹出的 “指定宏” 对话框中，选择刚才创建的 “ResizeSelectedPicture” 宏，点击 “确定”。
再次右键点击矩形，选择 “设置形状格式”，在右侧弹出的 “设置形状格式” 窗格中，选择 “填充与线条”，将 “填充” 设置为无填充，“线条” 设置为无线条，使按钮看起来更简洁。
拖动矩形按钮到合适的位置，使其成为浮动状态。你可以将鼠标放在按钮的边缘，当鼠标指针变为四向箭头时，按住鼠标左键拖动按钮到文档中的任意位置。
这样，在 WPS 2019 的 Word 文档中就添加了一个浮动按钮，当选中图片后，点击该按钮，就可以使用 VBA 代码设置选中图片的大小了。

cayuer

或者下段VBA

Private Sub CommandButton1_Click()
    On Error Resume Next  ' 错误处理
    Dim img As Object
   
    ' 尝试获取选中的嵌入式图片或浮动图片
    Set img = Selection.InlineShapes(1)
    If img Is Nothing Then
        Set img = Selection.ShapeRange(1)
    End If
   
    ' 调整图片大小（单位：磅，1厘米≈28.35磅）
    If Not img Is Nothing Then
        With img
            .LockAspectRatio = msoFalse  ' 解锁纵横比
            .Width = 300   ' 宽度设为300磅（约10.58厘米）
            .Height = 200  ' 高度设为200磅（约7.06厘米）
        End With
    Else
        MsgBox "请先选中一张图片！", vbExclamation
    End If
End Sub

lpf1014

一直只用，感觉还可以，可以试一试
Sub 批量修改选中图片尺寸()

高度 = InputBox("请输入高度")
宽度 = InputBox("请输入宽度")
纵横比 = InputBox("请输入是否锁定纵横比，1是锁定，0是解除")

For Each 图片 In Selection.InlineShapes
图片.LockAspectRatio = 纵横比
图片.Height = 高度 * 72 / 2.54
图片.Width = 宽度 * 72 / 2.54
Next

MsgBox ("提示：图片尺寸修改完成")
End Sub

hnzlf

cayuer 发表于 2025-4-18 09:56
前期准备
在 WPS 2019 中，点击 “文件” 菜单，选择 “选项”。在弹出的 “选项” 窗口中，选择 “自定义 ...

我文档中有多张图处，大于100张
如何获取当前选中的图片
Set shp = Selection.InlineShapes(1)
只能设置第一张图片