VBA批量调整图片宽度

上午花了点时间写了段代码调整WPS文字中图片的宽度，直接看图。

A）调整前，插入的图片都超过了wps内置文档的宽度，需要一个一个调整，图片量太大，调整起来相当繁琐又费时间。

B) 执行批量调整宽度代码后一次将宽度超过文档版心尺寸的图片宽度调整为版心尺寸，高度按比例缩放。

代码如下：

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