用VBA使每张图片高度宽度都一样

2806214

用VBA使每张图片高度宽度都一样

13907933959

网友好！

   本人是个菜鸟，这个代码是我收藏的，不知是那位前辈的，你试一下，看是不是你要的效果。

   打开Word文档，点上面的“工具”→“宏”→“宏”→“编辑器”→复制粘贴代码到空白处→“关闭代码窗口”→再点文档上面的“工具”→“宏”→“宏”→点击代码→“运行”→选择文件路经→点击文件→确定。

Sub 批量设置图片大下()
    Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As Document
    Dim myInlineShape As InlineShape
    On Error Resume Next    '忽略错误
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show = -1 Then    '确定
            Application.ScreenUpdating = False
            For Each vrtSelectedItem In .SelectedItems    '在所有选取项目中循环
                Set Doc = Documents.Open(FileName:=vrtSelectedItem, Visible:=False)
                With Doc
                    For Each myInlineShape In .InlineShapes
                        With myInlineShape
                            .LockAspectRatio = msoFalse  '不锁定纵横比
                            .Height = MillimetersToPoints(38.8)   '设置图片高度为38.8mm
                            .Width = MillimetersToPoints(51.8)   '设置图片宽度为58.8mm
                        End With
                    Next
                    .Saved = False
                    .Close True
                End With
            Next
            Application.ScreenUpdating = True
        End If
    End With
    MsgBox "格式化文档操作设置完毕!", vbInformation
End Sub

2806214

很好，很感谢，就是想要的