批量设置word 里图片的大小及版式的技巧

批量设置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

本文来源：https://www.2haoxitong.net/k/doc/6b0f45f35ef7ba0d4a733bbd.html