VBA_批量调整图片宽度

'版心尺寸大小（假设 Word 2003 中，A4纵向纸张，宽度已知是21厘米，左边距2.5厘米，右边距2.5厘米，所以，版心尺寸=宽度-左边距-右边距=16厘米）
Dim Width As Single, Left As Single, Right As Single
Width = Round(ActiveDocument.PageSetup.PageWidth / 28.35)
Left = Round(ActiveDocument.PageSetup.LeftMargin / 28.35, 1)
Right = Round(ActiveDocument.PageSetup.RightMargin / 28.35, 1)
MsgBox "版心尺寸是 " & (Width - Left - Right) & " 厘米"

Sub 图片宽度批量调整()
Dim i
Dim j
Dim oldHeight
Dim oldWidth
Dim newHeight
Dim newWidth
Dim docWidth
docWidth = 15 * 28.345

On Error Resume Next
For i = 1 To ActiveDocument.InlineShapes.Count
oldWidth = ActiveDocument.InlineShapes(i).Width
oldHeight = ActiveDocument.InlineShapes(i).Height
'如果长度大于内容区的长度则自动修改图片长度为内容区，图片高度按照比例压缩
If oldWidth > docWidth Then
newWidth = docWidth
newHeight = newWidth * oldHeight / oldWidth
End If
ActiveDocument.InlineShapes(i).Height = newHeight '修改为自己需要的值
ActiveDocument.InlineShapes(i).Width = newWidth '修改为自己需要的值

Next
For j = 1 To ActiveDocument.Shapes.Count
oldWidth = ActiveDocument.InlineShapes(i).Width
oldHeight = ActiveDocument.InlineShapes(i).Height
'如果长度大于内容区的长度则自动修改图片长度为内容区，图片高度按照比例压缩
If oldWidth > docWidth Then
newWidth = docWidth
newHeight = newWidth * oldHeight / oldWidth
End If
ActiveDocument.InlineShapes(j).Height = newHeight '修改为自己需要的值
ActiveDocument.InlineShapes(j).Width = newWidth '修改为自己需要的值

Next

End Sub