以下代码，已实测-好用。

Sub 图片大小()

On Error Resume Next

Dim mywidth

Dim myheight

Application.ScreenUpdating = False '关闭屏幕更新

mywidth = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,宽度根据输入的高度数值自动调整；", Title:="请输入图片宽度", Default:="0")) * 28.35

myheight = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,高度根据输入的宽度数值自动调整；", Title:="请输入图片高度", Default:="0")) * 28.35

'------------------------------------------------------------------

'调整嵌入式图形

Dim pic As InlineShape

For Each pic In ActiveDocument.InlineShapes

If mywidth = "0" Then

pic.Height = myheight

pic.ScaleWidth = pic.ScaleHeight

ElseIf myheight = "0" Then

pic.Width = mywidth

pic.ScaleHeight = pic.ScaleWidth

Else

pic.Width = mywidth

pic.Height = myheight

End If

Next

'调整浮动式图形

Dim tu As Shape

For Each tu In ActiveDocument.Shapes

If mywidth = "0" Then

tu.Height = myheight

ElseIf myheight = "0" Then

tu.Width = mywidth

Else

tu.LockAspectRatio = msoFalse

tu.Width = mywidth

tu.Height = myheight

End If

Next

Application.ScreenUpdating = True '恢复屏幕更新

End Sub