word编程宏批量修改图片大小

设定宽度大于8.5cm(两栏)图片，调整为8.5cm，高度随宽度继续比例调，保证图片不变形Sub setpicsize() '设置图片大小
Dim n '图片个数
Dim picwidth
Dim picheight
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片
picheight = ActiveDocument.InlineShapes(n).Height
picwidth = ActiveDocument.InlineShapes(n).Width
If picwidth > 241 Then
ActiveDocument.InlineShapes(n).Height = picheight * 241 / picwidth '设置高度按宽度比例调整ActiveDocument.InlineShapes(n).Width = 241 '设置宽度cm为任意28.345 * n
End If
Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
picheight = ActiveDocument.Shapes(n).Height
picwidth = ActiveDocument.Shapes(n).Width
If picwidth > 241 Then
ActiveDocument.Shapes(n).Height = picheight * 241 / picwidth '设置高度为按宽度比例调整ActiveDocument.Shapes(n).Width = 241 '设置宽度cm为任意28.345 * n
End If
Next n
End Sub
设定图片固定大小
Sub setpicsize() '设置图片大小
Dim n ' 图片个数
On Error Resume Next ' 忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes 类型图片ActiveDocument.InlineShapes(n).Height = 350 '设置图片高度为400px
ActiveDocument.InlineShapes(n).Width = 240 '设置图片宽度100px
Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes 类型图片
ActiveDocument.Shapes(n).Height = 350 '设置图片高度为400px
ActiveDocument.Shapes(n).Width = 240 '设置图片宽度100px
Next n
End Sub
设定图片统一宽度，高度不做处理
由于我只需要统一宽度，所以将统一高度的代码注释
Sub 图片格式统一()
'
' 图片格式统一宏
'
'
'Myheigth = 12
Mywidth = 14
On Error Resume Next '忽略错误
For Each iShape In ActiveDocument.InlineShapes
'iShape.Height = 28.345 * Myheigth '设置图片高度为任意cm
iShape.Width = 28.345 * 8.5 '设置图片宽度
Next
For Each Shape In ActiveDocument.Shapes
'Shape.Height = 28.345 * Myheigth '设置图片高度为任意cm
Shape.Width = 28.345 * 8.5 '设置图片宽度
Next
End Sub
设定图片统一调整比例
Sub setpicsize() '设置图片大小
Dim n '图片个数
Dim picwidth
Dim picheight
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片picheight = ActiveDocument.InlineShapes(n).Height
picwidth = ActiveDocument.InlineShapes(n).Width
ActiveDocument.InlineShapes(n).Height = picheight * 0.7 '设置高度为1.1倍ActiveDocument.InlineShapes(n).Width = picwidth * 0.7 '设置宽度为1.1倍Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片
picheight = ActiveDocument.Shapes(n).Height
picwidth = ActiveDocument.Shapes(n).Width
ActiveDocument.Shapes(n).Height = picheight * 0.7 '设置高度为1.1倍ActiveDocument.Shapes(n).Width = picwidth * 0.7 '设置宽度为1.1倍
Next n
设定图片统一调整比例
Sub 图片格式统一()
'
' 图片格式统一宏
'
'
'Myheigth = 12
Mywidth = 14
On Error Resume Next '忽略错误
For Each iShape In ActiveDocument.InlineShapes
iShape.Height = iShape.Height * 0.7 '设置图片高度为任意cm
iShape.Width = iShape.Width * 0.7 '设置图片宽度
Next
For Each Shape In ActiveDocument.Shapes
Shape.Height = iShape.Height * 0.7 '设置图片高度为任意cm
Shape.Width = iShape.Width * 0.7 '设置图片宽度
Next
End Sub
设定宽度大于8.5cm图片，调整为8.5cm，高度不做调整
Sub 图片格式统一()
'
' 图片格式统一宏
'
'
'Myheigth = 12
Mywidth = 14
On Error Resume Next '忽略错误
For Each iShape In ActiveDocument.InlineShapes
If iShape.Width > 28.345 * 8.5 Then
ActiveDocument.InlineShapes(n).LockAspectRatio=msotrue'打开纵横比锁定iShape.Width = 28.345 * 8.5 '设置图片宽度
iShape.Height = iShape.Height * 28.345 * 8.5/iShape.Width
End If
For Each Shape In ActiveDocument.Shapes
Shape.Width = 28.345 * 8.5 '设置图片宽度
iShape.Height = iShape.Height * 28.345 * 8.5/iShape.Width
Next
End Sub
Sub setpicsize() '设置图片大小
Dim n '图片个数
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.InlineShapes.Count 'InlineShapes类型图片ActiveDocument.InlineShapes(n).LockAspectRatio = msoTrue
If iShape.Width > 28.345 * 8.5 Then
ActiveDocument.InlineShapes(n).Width = 28.345 * 8.5 '设置图片宽度500px end if
Next n
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片ActiveDocument.InlineShapes(n).LockAspectRatio = msoTrue
If iShape.Width > 28.345 * 8.5 Then
ActiveDocument.Shapes(n).Width = 28.345 * 8.5 '设置图片宽度500px
end if
Next n
End Sub。