Word 利用 VBA 批量设置图片格式

• 批量设置图片格式
• Shape 与 InlineShape 转换
• • Shape 转 InlineShape
  • InlineShape 转 Shape
• 设置文字环绕类型
• • InlineShape
• 参考资料

批量设置图片格式

Sub setShapeStyle()  
    On Error Resume Next  
    Dim myShape As InlineShape
    
    ' 如果没有名叫“图片”的样式，提示用户创建
    Dim imgStyle As Style, imgStyleName As String
    imgStyleName = "图片"
    Set imgStyle = ActiveDocument.Styles(imgStyleName)
    If imgStyle Is Nothing Then
        MsgBox "请先创建样式【" & imgStyleName & "】"
        Exit Sub
    End If
    
    '关闭屏幕更新,提升执行效率
    Application.ScreenUpdating = False
    
    '遍历所有嵌入式图片
    For Each myShape In ActiveDocument.InlineShapes
        
        With myShape
            ' -------- 设置边框 --------
            .Borders.OutsideLineStyle = wdLineStyleSingle '边框类型
            .Borders.OutsideColorIndex = wdBlack '边框颜色
            .Borders.OutsideLineWidth = wdLineWidth100pt '边框粗细
            ' -------- 设置样式 --------
            If .Type = wdInlineShapePicture Then
                .Range.Style = imgStyleName  '设置图片样式为“图片”
            End If
            ' -------- 设置高宽 --------
            .ScaleWidth = 100  ' 缩放重置为100%
            .ScaleHeight = 100 ' 缩放重置为100%
            .LockAspectRatio = msoTrue  ' 锁定纵横比
            '.Height = 600 ' 600点
            '.Width = CentimetersToPoints(15) '15 CM
            .Width = ThisDocument.PageSetup.TextColumns.Width ' 当前文档宽度
            ' -------- 图片下方插入题注 --------
            .Range.InsertCaption Label:="图：", TitleAutoText:="", Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
        End With
        
    Next
    
    '开启屏幕更新
    Application.ScreenUpdating = True

End Sub

Shape 与 InlineShape 转换

对象	说明
Shape	代表绘图层中的对象，例如自选图形、任意多边形、OLE 对象、ActiveX 控件或图片。Shape 对象锁定到某一文本范围，但可以自由浮动，并且可以放置在页面上的任何位置。
InlineShape	代表文档的文字层中的对象。被视为字符置于文本行中。 内嵌形状只能是图片、OLE 对象或 ActiveX 控件。

Shape 转 InlineShape

ConvertToInlineShape：将文档绘图层的指定图形转换为文字层的嵌入式图形。 只能转换代表图片、OLE 对象或 ActiveX 控件的图形。 此方法返回一个 InlineShape 对象，该对象代表图片或 OLE 对象。
网上抄来改了一下：

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

参考资料

Office VBA 参考 》Word 》对象模型 》Style 对象
Office VBA 参考 》Word 》对象模型 》Range 对象 》方法 》插入题注InsertCaption
Office VBA 参考 》Word》对象模型 》InlineShape》对象》方法》Reset

Office VBA 参考 》Word 》对象模型 》枚举 》WdLineWidth 边框宽度
Office VBA 参考 》Word 》对象模型 》枚举 》WdInlineShapeType 形状类型
Office VBA 参考 》Word 》对象模型 》枚举 》WdWrapType 环绕文字

VBA操作WORD（五）批量调整图片大小、居中设置