批量修改大量word中的图片宽度

背景：需要批量修改大量word中的图片宽度。
流程：用一个bat遍历当前文件夹的word文件，然后将文件夹名传递给script.vbs脚本自动打开文件-（是否打开，人工点确认打开）-选择打开文件的内容（人工）-（是否打选择内容，人工点确认打开）-自动打开下一个文件。。。。
bat脚本

点击查看代码

@echo off
setlocal enabledelayedexpansion

:: 遍历当前目录下的所有 Word 文件
for %%F in (*.docx) do (
    echo 正在处理文件: "%%~fF"
    echo "%%~fF" >> debug_log.txt  :: 记录路径，方便调试
    cscript //nologo script.vbs "%%~fF"
)

echo 所有文件处理完成！
pause

vbs脚本

点击查看代码

Dim wordApp, doc, fileName
fileName = WScript.Arguments(0) ' 读取传入的文件路径

' 调试输出文件路径，检查是否正确
MsgBox "即将打开文件: " & fileName, vbInformation, "调试信息"

' 启动 Word
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True ' 显示 Word 窗口，方便手动选中内容

' 检查文件是否存在
If Not CreateObject("Scripting.FileSystemObject").FileExists(fileName) Then
    MsgBox "错误：找不到文件！" & vbCrLf & fileName, vbExclamation, "文件错误"
    WScript.Quit
End If

' 打开 Word 文档
Set doc = wordApp.Documents.Open(fileName)

' 提示用户手动选中需要调整的文本和图片
MsgBox "请手动选中需要调整的内容（包括图片），然后点击 '确定' 继续。", vbInformation, "手动选择内容"

' 确保用户已选中内容
Do While wordApp.Selection.Type = 0
    WScript.Sleep 500
Loop

' 设置目标宽度 (14.65 cm 转换为磅)
Dim targetWidth
targetWidth = 14.65 * 28.35  ' 1 cm = 28.35 磅

' 遍历选中内容中的所有图片
Dim iShape
For Each iShape In wordApp.Selection.InlineShapes
    If iShape.Type = 3 Then ' 确保是图片
        iShape.LockAspectRatio = False ' 允许调整宽度
        iShape.Width = targetWidth ' 统一设置宽度
    End If
Next

' 提示用户修改完成
MsgBox "选中内容中的图片已调整为 14.65 cm 宽！", vbInformation, "调整完成"

' 保存并关闭文档
doc.Save
doc.Close

' 退出 Word
wordApp.Quit
Set doc = Nothing
Set wordApp = Nothing