VBA_批量调整图片宽度

来源:互联网 发布:extend软件 编辑:程序博客网 时间:2024/04/28 06:25
'版心尺寸大小(假设 Word 2003 中,A4纵向纸张,宽度已知是21厘米,左边距2.5厘米,右边距2.5厘米,所以,版心尺寸=宽度-左边距-右边距=16厘米)    Dim Width As Single, Left As Single, Right As Single    Width = Round(ActiveDocument.PageSetup.PageWidth / 28.35)    Left = Round(ActiveDocument.PageSetup.LeftMargin / 28.35, 1)    Right = Round(ActiveDocument.PageSetup.RightMargin / 28.35, 1)    MsgBox "版心尺寸是 " & (Width - Left - Right) & " 厘米"Sub 图片宽度批量调整()Dim iDim jDim oldHeightDim oldWidthDim newHeightDim newWidthDim docWidthdocWidth = 15 * 28.345On Error Resume NextFor i = 1 To ActiveDocument.InlineShapes.Count oldWidth = ActiveDocument.InlineShapes(i).Width oldHeight = ActiveDocument.InlineShapes(i).Height '如果长度大于内容区的长度则自动修改图片长度为内容区,图片高度按照比例压缩 If oldWidth > docWidth Then     newWidth = docWidth     newHeight = newWidth * oldHeight / oldWidth End If ActiveDocument.InlineShapes(i).Height = newHeight '修改为自己需要的值 ActiveDocument.InlineShapes(i).Width = newWidth '修改为自己需要的值NextFor j = 1 To ActiveDocument.Shapes.Count  oldWidth = ActiveDocument.InlineShapes(i).Width  oldHeight = ActiveDocument.InlineShapes(i).Height '如果长度大于内容区的长度则自动修改图片长度为内容区,图片高度按照比例压缩 If oldWidth > docWidth Then     newWidth = docWidth     newHeight = newWidth * oldHeight / oldWidth End If ActiveDocument.InlineShapes(j).Height = newHeight '修改为自己需要的值 ActiveDocument.InlineShapes(j).Width = newWidth '修改为自己需要的值NextEnd Sub
0 0