自动调整word文档中的图片大小及版式

批量设置word里图片的大小及版式的技巧1.批量设置固定大小工具-宏-新建Subsetpicsize()'设置图片大小Dimn'图片个数OnErrorResumeNext'忽略错误Forn=1ToActiveDocument.Shapes.Count'Shapes类型图片ActiveDocument.Shapes(n).Height=70'设置图片高度为70pxActiveDocument.Shapes(n).Width=80'设置图片宽度80pxNextnEndSub运行即可2.批量按比率缩小或放大新建宏Subsetpicsize()'设置图片大小Dimn'图片个数DimpicwidthDimpicheightOnErrorResumeNext'忽略错误Forn=1ToActiveDocument.InlineShapes.Count'InlineShapes类型图片picheight=ActiveDocument.InlineShapes(n).Heightpicwidth=ActiveDocument.InlineShapes(n).WidthActiveDocument.InlineShapes(n).Height=picheight*0.7'设置高度为0.7倍ActiveDocument.InlineShapes(n).Width=picwidth*0.7'设置宽度为0.7倍NextnForn=1ToActiveDocument.Shapes.Count'Shapes类型图片picheight=ActiveDocument.Shapes(n).Heightpicwidth=ActiveDocument.Shapes(n).WidthActiveDocument.Shapes(n).Height=picheight*0.7'设置高度为0.7倍ActiveDocument.Shapes(n).Width=picwidth*0.7'设置宽度为0.7倍NextnEndSub3批量将图片转成嵌入型新建宏Sub图片转嵌入型()DimapicAsShapeApplication.ScreenUpdating=FalseForEachapicInActiveDocument.Shapesapic.ConvertToInlineShape'转换为嵌入型NextApplication.ScreenUpdating=TrueSelection.MoveRightUnit:=wdCharacter,Count:=1,Extend:=wdExtendWithSelection.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=wdBaselineAlignAutoEndWithEndSub4.批量将图片转四周型新建宏Sub图片版式转换四周型()DimapicAsVariant,shapeTypeAsWdWrapTypeOnErrorResumeNextForEachapicInActiveDocument.InlineShapesapic.ConvertToShapeWithoShapeoShape.WrapFormat.Type=0'四周型oShape.WrapFormat.AllowOverlap=False'不允许重叠EndWithNextEndSub