word批量操作图片到指定位置改变大小改变版式

直接上教程

环境：winx office2019 语言：vba word 第一步：插入图片，这里不再赘述 重要代码

调整尺寸

代码语言：javascript复制

Sub FormatPics()
Dim iSha As InlineShape
For Each iSha In ActiveDocument.InlineShapes
If iSha.Type = wdInlineShapePicture Then
iSha.LockAspectRatio = msoFalse
iSha.Width = CentimetersToPoints(2.85)
iSha.Height = CentimetersToPoints(2.85)
End If
Next
End Sub

其中数字代表图片尺寸大小单位为cm

代码语言：javascript复制

Sub 每页一个图片()
'
' 每页一个图片 宏
'
'
Dim iSha As InlineShape
For Each iSha In ActiveDocument.InlineShapes
If iSha.Type = wdInlineShapePicture Then
    Selection.InsertBreak Type:=wdPageBreak
    Selection.MoveRight Unit:=wdCharacter, Count:=1
 End If
Next
End Sub

将图片插入分页符，实现每页上一张图片的功能

修改图片版式

代码语言：javascript复制

Sub 图片版式转换()
    Dim oShape As Variant, shapeType As WdWrapType
    On Error Resume Next
    If MsgBox("Y将图片由嵌入式转为浮动式,N将图片由浮动式转为嵌入式", 68) = 6 Then
        shapeType = Val(InputBox(Prompt:="请输入图片版式:0=四周型,1=紧密型, " & vbLf & _
                                         "3=衬于文字下方,4=浮于文字上方", Default:=0))
        For Each oShape In ActiveDocument.InlineShapes
        
            oShape.Select
          
            Set oShape = oShape.ConvertToShape
            With oShape
                Select Case shapeType
                Case 0, 1
                    .WrapFormat.Type = shapeType
                Case 3
                    .WrapFormat.Type = 3
                    .ZOrder 5
                Case 4
                    .WrapFormat.Type = 3
                    .ZOrder 4
                Case Else
                    Exit Sub
                End Select
                .WrapFormat.AllowOverlap = False    '不允许重叠
            End With
        Next
    Else
        For Each oShape In ActiveDocument.Shapes
            oShape.ConvertToInlineShape
        Next
    End If
End Sub

关键步骤

将文档保存为【.doc】格式，因为docx不支持选择多个对象功能；

如何调出这个菜单？

选择完后，统一修改图片位置，干什么都可以了！

vba docx word 分页 教程

0 人点赞