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

Sub 图片对齐() 1
Sub 图片大小() 1
Sub 浮于文字上方() 3
Sub 浮于文字上方() 3
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，则图片保持原始纵横比,宽度根据输入的高度数值自动调整；", Title:="请输入图片宽度", Default:="0")) * 28.35
myheight = Val(InputBox(Prompt:="单位为厘米(cm);如果输入为0，则图片保持原始纵横比,高度根据输入的宽度数值自动调整；", Title:="请输入图片高度", Default:="0")) * 28.35
'-------------
'调整嵌入式图形
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将图片由浮动式转为嵌入式", 68) = 6 Then
shapeType = Val(InputBox(Prompt:="请输入图片版式:0=四周型,1=紧密型, " & vbLf & _
"3=衬于文字下方,4=浮于文字上方", Default:=0))
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