word批量设置图片大小和对齐,使用宏定义

word使用宏定义来批量设置图片大小

打开word中开发工具,文件→选项→word选项
word批量设置图片大小和对齐,使用宏定义_第1张图片
新建Visual Basic文件
word批量设置图片大小和对齐,使用宏定义_第2张图片
点击 插入→模块
word批量设置图片大小和对齐,使用宏定义_第3张图片
复制下列任意代码,粘贴到右侧。(注意可以灵活设置Myheigth或者Mywidth)
点击小三角,运行即可。
word批量设置图片大小和对齐,使用宏定义_第4张图片
如何获取理想的Myheigth或Mywidth,选中一张图片,调节成适合的高度或者宽度,把数值记下来,赋值给Myheigth或Mywidth即可。
word批量设置图片大小和对齐,使用宏定义_第5张图片

下列代码任选其一,粘贴即可
前提条件:图片文字环绕模式都必须为“嵌入式图形”

固定宽度

' 锁定图片的纵横比,固定宽度,高度任意
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

Shape 转 InlineShape(嵌入式图形)

ConvertToInlineShape:将文档绘图层的指定图形转换为文字层的嵌入式图形。 只能转换代表图片、OLE 对象或 ActiveX 控件的图形。 此方法返回一个 InlineShape 对象,该对象代表图片或 OLE 对象。
(注意,一次执行可能不会替换所有图片,需要多次执行,直到count为1)

Sub ConvertToInlineShape()
    Dim total, count
    count = 0
    total = 0
    For Each myShape In ActiveDocument.Shapes
        If myShape.Type = msoPicture Then
            ' 转换为嵌入式形状
            myShape.ConvertToInlineShape
            count = count + 1
        End If
        total = total + 1
    Next myShape
    
    MsgBox "转换【" & count & "/" & total & "】个图片!"
    
End Sub

InlineShape(嵌入式图形) 转 Shape

ConvertToShape:将嵌入式图形转换为可自由浮动的图形。 返回一个 Shape 对象,该对象代表新图形。

Sub ConvertToShape()
    Dim total, count
    count = 0
    total = 0
    For Each myShape In ActiveDocument.InlineShapes
        If myShape.Type = wdInlineShapePicture Then
            ' 转换为嵌入式图片
            myShape.ConvertToShape            
            count = count + 1
        End If
        total = total + 1
    Next myShape
    
    MsgBox "转换【" & count & "/" & total & "】个图片!"
    
End Sub

设置文字环绕类型

Shape 对象有个 WrapFormat 属性,可以用来设置文字环绕。

Sub SetWrapFormat(myShape, wrapType)
   
    With myShape.WrapFormat
         .Type = wrapType                       ' 设置文字环绕方式
         .Side = wdWrapBoth                     ' 设置环绕在哪一侧面
         
         ' 设置文字与指定的图形周围的文本区的边缘之间的距离 (单位磅)
         .DistanceTop = InchesToPoints(0.1)
         .DistanceBottom = InchesToPoints(0.1)
         .DistanceLeft = InchesToPoints(0.1)
         .DistanceRight = InchesToPoints(0.1)
    End With
    
End Sub

Sub test1()
    SetWrapFormat ActiveDocument.Shapes(1), wdWrapTight ' 紧密环绕
End Sub

Sub test2()
    SetWrapFormat ActiveDocument.Shapes(1), wdWrapTopBottom ' 上下环绕
End Sub

Sub test3()
    ActiveDocument.Shapes.Range(Array(1, 1)).WrapFormat.Type = wdWrapTight   ' 紧密
End Sub
Sub test4()
    ActiveDocument.Shapes.Range(Array(1, 1)).WrapFormat.Type = wdWrapTopBottom ' 上下
End Sub

InlineShape

InlineShape 没有 WrapFormat 可以先转为 Shape 再处理。

ActiveDocument.Shapes(1).ConvertToShape.WrapFormat.Type = wdWrapTight

参考资料

参考:
ShapeRange object (Project) | Microsoft Docs
LockAspectRatio
InlineShapes object (Word) | Microsoft Docs
word使用宏定义来统一设置图片大小
Word 利用 VBA 批量设置图片格式_vba word shape.item_笑虾的博客

你可能感兴趣的:(VBS,VB,word)