VBA批量調整圖片寬度
阿新 • • 發佈:2019-02-07
上午花了點時間寫了段程式碼調整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