WTBD
WTBD
Published on 2024-09-29 / 54 Visits
2

文档里面批量插入图片(docm)

' VBA代码(WORD另存为docm文件格式打开后按住alt+f11讲代码粘贴进入保存,然后alt+f8运行即可)
Sub BatchInsertAndResizeImages()
    Dim imgFolder As String
    Dim imgFile As String
    Dim shape As InlineShape
    Dim picWidth As Single
    Dim picHeight As Single
    Dim table As table
    Dim rowCount As Integer
    Dim colCount As Integer
    Dim currentRow As Integer
    Dim currentCol As Integer
    Dim maxCols As Integer
    Dim rng As Range

    ' 指定图片文件夹路径,这里输入需要插入图片的文件夹地址,请注意最后需要接一个\
    imgFolder = "C:\Users\17777\Desktop\图片测试\"
    
    ' 指定图片宽度和高度(单位:磅),你可以根据需要调整
    picWidth = 100 ' 图片宽度
    picHeight = 100 ' 图片高度

    ' 每行显示的图片数(列数),可以设置为4或者5
    maxCols = 4 ' 每行显示的图片数

    ' 获取文档末尾的 Range 对象
    Set rng = ActiveDocument.Content
    rng.Collapse Direction:=wdCollapseEnd

    ' 在文档末尾插入一个表格,用于排列图片
    Set table = ActiveDocument.Tables.Add(rng, 1, maxCols)
    
    ' 设置表格边框和样式,可以根据需要调整
    table.Borders.Enable = False

    ' 初始化当前行和列
    currentRow = 1
    currentCol = 1

    ' 获取文件夹中的第一个图片文件
    imgFile = Dir(imgFolder & "*.*")

    ' 遍历文件夹中的所有图片文件
    Do While imgFile <> ""
        ' 如果列数超过最大列数,则增加新行
        If currentCol > maxCols Then
            currentRow = currentRow + 1
            table.Rows.Add ' 增加新行
            currentCol = 1 ' 重置为第一列
        End If

        ' 在当前单元格中插入图片
        Set shape = table.Cell(currentRow, currentCol).Range.InlineShapes.AddPicture(FileName:=imgFolder & imgFile, LinkToFile:=False, SaveWithDocument:=True)

        ' 调整图片大小
        With shape
            .LockAspectRatio = msoFalse
            .Width = picWidth
            .Height = picHeight
        End With
        
        ' 切换到下一个单元格
        currentCol = currentCol + 1

        ' 获取下一个图片文件
        imgFile = Dir
    Loop

    MsgBox "图片插入并调整完成!"
End Sub