批量设置word 里图片的大小及版式的技巧
1.批量设置固定大小
工具-宏-新建
Sub setpicsize() '设置图片大小 Dim n '图片个数
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片 ActiveDocument.Shapes(n).Height = 70 '设置图片高度为 70px ActiveDocument.Shapes(n).Width = 80 '设置图片宽度 80px Next n End Sub 运行即可
2.批量按比率缩小或放大
新建宏
Sub setpicsize() '设置图片大小 Dim n '图片个数 Dim picwidth Dim picheight
On Error Resume Next '忽略错误
For n = 1 To ActiveDocument.Shapes.Count 'Shapes类型图片 picheight = ActiveDocument.Shapes(n).Height picwidth = ActiveDocument.Shapes(n).Width
ActiveDocument.Shapes(n).Height = picheight * 0.5 '设置高度为0.5倍 ActiveDocument.Shapes(n).Width = picwidth * 0.5 '设置宽度为0.5倍 Next n End Sub
3批量将图片转成嵌入型
新建宏
Sub 图片转嵌入型() Dim apic As Shape
Application.ScreenUpdating = False
For Each apic In ActiveDocument.Shapes
apic.ConvertToInlineShape '转换为嵌入型 Next
Application.ScreenUpdating = True
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend With Selection.ParagraphFormat
.LeftIndent = MillimetersToPoints(0) .RightIndent = MillimetersToPoints(0)
.SpaceBefore = 6
.SpaceBeforeAuto = False .SpaceAfter = 6
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle .Alignment = wdAlignParagraphCenter .WidowControl = False .KeepWithNext = False .KeepTogether = False .PageBreakBefore = False .NoLineNumber = False .Hyphenation = True
.FirstLineIndent = MillimetersToPoints(0) .OutlineLevel = wdOutlineLevelBodyText .CharacterUnitLeftIndent = 0 .CharacterUnitRightIndent = 0 .CharacterUnitFirstLineIndent = 0 .LineUnitBefore = 0 .LineUnitAfter = 0
.AutoAdjustRightIndent = True .DisableLineHeightGrid = False .FarEastLineBreakControl = True .WordWrap = True
.HangingPunctuation = True
.HalfWidthPunctuationOnTopOfLine = False .AddSpaceBetweenFarEastAndAlpha = True .AddSpaceBetweenFarEastAndDigit = True .BaseLineAlignment = wdBaselineAlignAuto End With End Sub
4.批量将图片转四周型
新建宏
Sub 图片版式转换四周型()
Dim apic As Variant, shapeType As WdWrapType On Error Resume Next
For Each apic In ActiveDocument.InlineShapes apic.ConvertToShape With oShape
oShape.WrapFormat.Type = 0 '四周型
oShape.WrapFormat.AllowOverlap = False '不允许重叠 End With Next End Sub
