打开word中开发工具,文件→选项→word选项
新建Visual Basic文件
点击 插入→模块
复制下列任意代码,粘贴到右侧。(注意可以灵活设置Myheigth或者Mywidth)
点击小三角,运行即可。
如何获取理想的Myheigth或Mywidth,选中一张图片,调节成适合的高度或者宽度,把数值记下来,赋值给Myheigth或Mywidth即可。
下列代码任选其一,粘贴即可
- ' 锁定图片的纵横比,固定宽度,高度任意
- Sub 批量设置图片大小()
-
- Mywidth = 12 '厘米
- On Error Resume Next '忽略错误
-
- For Each iShape In ActiveDocument.InlineShapes
- iShape.LockAspectRatio = msoTrue '锁定图片的纵横比
- iShape.Width = 28.345 * Mywidth '设置图片宽度
- Next
-
- End Sub
-
- ' 锁定图片的纵横比,固定高度,宽度任意
- Sub 批量设置图片大小()
-
- Myheigth = 18 '厘米
- On Error Resume Next '忽略错误
-
- For Each iShape In ActiveDocument.InlineShapes
- iShape.LockAspectRatio = msoTrue '锁定图片的纵横比
- iShape.Height = 28.345 * Myheigth '设置图片高度为任意cm
- Next
-
- End Sub
-
- ' 不锁定图片的纵横比,固定高度,固定宽度
- Sub 批量设置图片大小()
-
- Myheigth = 18 '厘米
- Mywidth = 12 '厘米
- On Error Resume Next '忽略错误
-
- For Each iShape In ActiveDocument.InlineShapes
- iShape.LockAspectRatio = msoFalse '不锁定图片的纵横比
- iShape.Height = 28.345 * Myheigth '设置图片高度为任意cm
- iShape.Width = 28.345 * Mywidth '设置图片宽度
- Next
-
- End Sub
-
- ' 不锁定图片的纵横比,固定高度,固定宽度
- Sub 批量设置图片大小()
-
- Myheigth = InputBox("输入一个高度值") '厘米
- Mywidth = InputBox("输入一个宽度值") '厘米
- On Error Resume Next '忽略错误
-
- For Each iShape In ActiveDocument.InlineShapes
- iShape.LockAspectRatio = msoFalse '不锁定图片的纵横比
- iShape.Height = 28.345 * Myheigth '设置图片高度为任意cm
- iShape.Width = 28.345 * Mywidth '设置图片宽度
- Next
-
- End Sub
-
具体讲解,调用了VB的ShapeRange 对象,有很多方法,比如
- Sub 批量设置图片大小()
- ...
- End Sub
-
- For Each iShape In ActiveDocument.InlineShapes
- iShape.Width = 28.345 * Mywidth '设置图片宽度为任意cm
- ...
- Next
-
-
- 批量设置图片大小宏, 下面这些注释提供参考,灵活修改
- Myheigth = 18 '厘米
- Mywidth = 12 '厘米
- iShape.Height = 28.345 * Myheigth '设置图片高度为任意cm
- iShape.Width = 28.345 * Mywidth '设置图片宽度为任意cm
- iShape.LockAspectRatio = msoFalse '不锁定图片的纵横比
- iShape.LockAspectRatio = msoTrue '锁定图片的纵横比
-
下面代码与大小调节代码不能一起运行,需要单独运行
- Sub 批量设置图片对齐方式()
- ' .Alignment = wdAlignParagraphLeft '左对齐
- ' .Alignment = wdAlignParagraphCenter '居中
- ' .Alignment = wdAlignParagraphRight '右对齐
-
- Selection.Find.ClearFormatting
- Selection.Find.Replacement.ClearFormatting
- With Selection.Find.Replacement.ParagraphFormat
- .SpaceBeforeAuto = False
- .SpaceAfterAuto = False
- .Alignment = wdAlignParagraphRight '右对齐,可修改为其他
- .WordWrap = True
- End With
- With Selection.Find
- .Text = "^g"
- .Replacement.Text = ""
- .Forward = True
- .Wrap = wdFindContinue
- .Format = True
- .MatchCase = False
- .MatchWholeWord = False
- .MatchByte = True
- .MatchWildcards = False
- .MatchSoundsLike = False
- .MatchAllWordForms = False
- End With
- Selection.Find.Execute Replace:=wdReplaceAll
- End Sub
-
参考:
ShapeRange object (Project) | Microsoft Docs