用宏批量调整word中图片版式、大小、方向

Sub 图片对齐() .......................................................................................................................................... 1 Sub 图片大小() .......................................................................................................................................... 1 Sub 浮于文字上方() ................................................................................................... 错误!未定义书签。 Sub 浮于文字上方() .................................................................................................................................. 4 Sub 连续() .................................................................................................................................................. 4 Sub 版式转换() .......................................................................................................................................... 4 Sub 图片方向() .......................................................................................................................................... 5

Sub 图片对齐()

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

On Error Resume Next

For n = 1 To ActiveDocument.Shapes.Count ActiveDocument.Shapes(n).Select

Selection.ShapeRange.RelativeHorizontalPosition = _ wdRelativeHorizontalPositionMargin Selection.ShapeRange.RelativeVerticalPosition = _ wdRelativeVerticalPositionMargin Selection.ShapeRange.Left = wdShapeRight Selection.ShapeRange.Top = wdShapeBottom Selection.ShapeRange.LockAnchor = False Selection.ShapeRange.LayoutInCell = True

Selection.ShapeRange.WrapFormat.AllowOverlap = False Selection.ShapeRange.WrapFormat.Side = wdWrapBoth Next

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

Sub 图片大小() On Error Resume Next Dim mywidth

Dim myheight

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

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

myheight = Val(InputBox(Prompt:=\"单位为厘米(cm);如果输入为0，则图片保持原始纵横比,高度根据输入的宽度数值自动调整；\请输入图片高度\'------------------------------------------------------------------ '调整嵌入式图形 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

Sub 浮于文字上方()

Dim oShape As Variant, tu As Shape, i

Application.ScreenUpdating = False '关闭屏幕更新 On Error Resume Next

'调整嵌入图形为浮于文字上方，并旋转90度 For Each oShape In ActiveDocument.InlineShapes Set oShape = oShape.ConvertToShape ActiveDocument.InlineShapes(i).Select With oShape

.WrapFormat.Type = 3' (去除.Zorder行 .WrapFormat.Type = shapeType四周形 .WrapFormat.Type = wdWrapTight紧密形 改为.ConvertToInlineShape嵌入形) .ZOrder 4 '4浮于文字上方 5衬于下方

.Rotation = -90#

End With Next

'调整其它图形为浮于文字上方，并旋转90度 For Each tu In ActiveDocument.Shapes ActiveDocument.Shapes(i).Select With tu

.WrapFormat.Type = 3 ' (去除.Zorder行 .WrapFormat.Type = shapeType四周形 .WrapFormat.Type = wdWrapTight紧密形 改为.ConvertToInlineShape嵌入形) .ZOrder 4 '4浮于文字上方 5衬于下方 .Rotation = -90# End With Next

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

Sub 浮于文字上方() Dim oShape As Variant, i

Application.ScreenUpdating = False '关闭屏幕更新 On Error Resume Next

For Each oShape In ActiveDocument.InlineShapes Set oShape = oShape.ConvertToShape

ActiveDocument.InlineShapes(i).Select '选中图片 With oShape

.ZOrder 4 '选中图片版式调为浮于文字上方 .Rotation = -90# '选中图片向左旋转90度 End With Next

Application.ScreenUpdating = True '关闭屏幕更新 End Sub

Sub 连续() Call 浮于文字上方 Call 图片大小 Call 图片对齐 End Sub

Sub 版式转换()

Dim oShape As Variant, shapeType As WdWrapType On Error Resume Next

If MsgBox(\"Y将图片由嵌入式转为浮动式,N将图片由浮动式转为嵌入式\ shapeType = Val(InputBox(Prompt:=\"请输入图片版式:0=四周型,1=紧密型, \" & vbLf & _ \"3=衬于文字下方,4=浮于文字上方\ For Each oShape In ActiveDocument.InlineShapes Set oShape = oShape.ConvertToShape With oShape

Select Case shapeType Case 0, 1

.WrapFormat.Type = shapeType Case 3

.WrapFormat.Type = 3 .ZOrder 5 Case 4

.WrapFormat.Type = 3 .ZOrder 4 Case Else Exit Sub End Select

.WrapFormat.AllowOverlap = False End With Next Else

For Each oShape In ActiveDocument.Shapes oShape.ConvertToInlineShape Next End If End Sub

Sub 图片方向() Dim n

On Error Resume Next

For n = 1 To ActiveDocument.Shapes.Count

ActiveDocument.Shapes(n).IncrementRotation -90#

Next n End Sub