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

Sub 图片对齐()1Sub 图片大小()1Sub 浮于文字上方()3Sub 浮于文字上方()3Sub 连续()4Sub 版式转换()4Sub 图片方向()5Sub 图片对齐()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 SubSub 图片大小()On Error Resume NextDim mywidthDim myheightApplication.ScreenUpdating = False 关闭屏幕更新mywidth = Val(InputBox(Prompt:=单位为厘米(cm);如果输入为0，则图片保持原始纵横比,宽度根据输入的高度数值自动调整；, Title:=请输入图片宽度, Default:=0) * 28.35myheight = Val(InputBox(Prompt:=单位为厘米(cm);如果输入为0，则图片保持原始纵横比,高度根据输入的宽度数值自动调整；, Title:=请输入图片高度, Default:=0) * 28.35-调整嵌入式图形Dim pic As InlineShapeFor Each pic In ActiveDocument.InlineShapesIf mywidth = 0 Thenpic.Height = myheightpic.ScaleWidth = pic.ScaleHeightElseIf myheight = 0 Thenpic.Width = mywidthpic.ScaleHeight = pic.ScaleWidthElsepic.Width = mywidthpic.Height = myheightEnd IfNext调整浮动式图形Dim tu As ShapeFor Each tu In ActiveDocument.ShapesIf mywidth = 0 Thentu.Height = myheightElseIf myheight = 0 Thentu.Width = mywidthElsetu.LockAspectRatio = msoFalsetu.Width = mywidthtu.Height = myheightEnd IfNext Application.ScreenUpdating = True 恢复屏幕更新End SubSub 浮于文字上方() 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 SubSub 浮于文字上方() Dim oShape As Variant, iApplication.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 NextApplication.ScreenUpdating = True 关闭屏幕更新End SubSub 连续()Call 浮于文字上方Call 图片大小Call 图片对齐End SubSub 版式转换() 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 SubSub 图片方向() Dim n On Error Resume Next For n = 1 To ActiveDocument.Shapes.Count ActiveDocument.Shapes(n).IncrementRotation -90# Next nEnd Sub