Sub 批量调整图片大小() Dim ishp As InlineShape Dim shp As Shape Dim picH As Single, picW As Single Dim hPt As Single, wPt As Single '输入自定义尺寸 On Error Resume Next picH = Val(InputBox("输入图片高度(厘米)", "尺寸设定", "5")) picW = Val(InputBox("输入图片宽度(厘米)", "尺寸设定", "7")) On Error GoTo 0 If picH <= 0 Or picW <= 0 Then MsgBox "尺寸数值无效，终止操作", vbExclamation Exit Sub End If hPt = CentimetersToPoints(picH) wPt = CentimetersToPoints(picW) Application.ScreenUpdating = False '处理嵌入式图片 For Each ishp In ActiveDocument.InlineShapes If ishp.Type = wdInlineShapePicture Then ishp.LockAspectRatio = msoFalse ishp.Height = hPt ishp.Width = wPt End If Next '处理浮动图片 For Each shp In ActiveDocument.Shapes If shp.Type = msoPicture Or shp.Type = msoLinkedPicture Then shp.LockAspectRatio = msoFalse shp.Height = hPt shp.Width = wPt End If Next Application.ScreenUpdating = True MsgBox "当前文档图片尺寸调整完毕", vbInformationEnd Sub