关于Word VBA批量粘贴形状并将文件夹图片依次填充至形状的技术咨询

嗨，看起来你已经搞定了批量粘贴形状到每页的问题——去掉startPosition的思路确实戳中了之前代码的痛点，之前每次循环都回到初始位置，才导致所有粘贴都堆在同一页，现在这个问题解决了就好办多了！

针对你现在想把文件夹里的图片依次填充到这些形状里的需求，我给你整理了两套可行的VBA方案，分场景来用：

场景1：已经用现有代码批量粘贴好形状，现在要填充图片 #

如果已经在每一页都有了要填充的形状（假设每页只有1个目标形状），可以用下面的代码遍历指定文件夹的图片，依次对应填充到每页的形状中：

Sub FillShapesWithFolderImages()
    Dim imgFolder As String
    Dim imgFile As String
    Dim currentPage As Integer
    Dim totalPages As Integer
    Dim targetShape As Shape
    Dim imgIndex As Integer
    
    ' 选择要导入图片的文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择存放图片的文件夹"
        If .Show = -1 Then
            imgFolder = .SelectedItems(1) & "\"
        Else
            MsgBox "未选择文件夹，程序退出"
            Exit Sub
        End If
    End With
    
    ' 获取文档总页数
    totalPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    imgIndex = 1
    
    ' 遍历每页，填充对应图片
    For currentPage = 1 To totalPages
        ' 跳转到当前页
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=currentPage
        
        ' 获取当前页的第一个形状（如果每页有多个形状，可根据名称/类型筛选）
        On Error Resume Next
        Set targetShape = ActiveDocument.Shapes(1)
        ' 示例：如果给目标形状统一命名为"FillShape"，可以改成 Set targetShape = ActiveDocument.Shapes("FillShape")
        On Error GoTo 0
        
        If Not targetShape Is Nothing Then
            ' 获取文件夹里的图片文件（按顺序取.jpg，可扩展格式）
            imgFile = Dir(imgFolder & "*.jpg")
            ' 跳转到第imgIndex个图片
            For i = 1 To imgIndex - 1
                imgFile = Dir
                If imgFile = "" Then Exit For
            Next i
            
            If imgFile <> "" Then
                ' 设置形状填充为图片，拉伸适配形状
                With targetShape.Fill
                    .UserPicture imgFolder & imgFile
                    .Visible = msoTrue
                    .TextureTile = msoFalse
                End With
                imgIndex = imgIndex + 1
            Else
                MsgBox "第" & currentPage & "页没有匹配的图片"
            End If
        Else
            MsgBox "第" & currentPage & "页未找到目标形状"
        End If
    Next currentPage
    
    MsgBox "图片填充完成！"
End Sub

场景2：一步到位——创建形状+填充图片 #

如果不想先手动粘贴形状，直接在每页创建符合要求（撑满页面除页脚）的形状并填充图片，可以用下面的代码，效率更高：

Sub CreateShapesAndFillImages()
    Dim imgFolder As String
    Dim imgFile As String
    Dim currentPage As Integer
    Dim totalPages As Integer
    Dim newShape As Shape
    Dim pageWidth As Single
    Dim pageHeight As Single
    Dim footerHeight As Single
    
    ' 选择图片文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择存放图片的文件夹"
        If .Show = -1 Then
            imgFolder = .SelectedItems(1) & "\"
        Else
            MsgBox "未选择文件夹，程序退出"
            Exit Sub
        End If
    End With
    
    ' 计算页面可用尺寸（排除页边距和页脚）
    With ActiveDocument.PageSetup
        pageWidth = .PageWidth - .LeftMargin - .RightMargin
        footerHeight = .FooterDistance
        pageHeight = .PageHeight - .TopMargin - .BottomMargin - footerHeight
    End With
    
    totalPages = ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)
    imgFile = Dir(imgFolder & "*.jpg") ' 先获取第一个图片
    
    For currentPage = 1 To totalPages
        ' 跳转到当前页开头
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=currentPage
        
        ' 创建矩形形状（撑满页面可用区域）
        Set newShape = ActiveDocument.Shapes.AddShape( _
            Type:=msoShapeRectangle, _
            Left:=ActiveDocument.PageSetup.LeftMargin, _
            Top:=ActiveDocument.PageSetup.TopMargin, _
            Width:=pageWidth, _
            Height:=pageHeight)
        
        ' 设置形状环绕方式，避免干扰文档排版
        newShape.WrapFormat.Type = wdWrapBehind
        
        ' 如果有图片，填充形状
        If imgFile <> "" Then
            With newShape.Fill
                .UserPicture imgFolder & imgFile
                .Visible = msoTrue
                .TextureTile = msoFalse
            End With
            imgFile = Dir ' 获取下一张图片
        Else
            MsgBox "第" & currentPage & "页没有可用图片，形状已创建但未填充"
        End If
    Next currentPage
    
    MsgBox "形状创建与图片填充完成！"
End Sub

小提醒： #

• 图片格式：代码默认取.jpg，如果需要支持.png等格式，可以把Dir(imgFolder & "*.jpg")改成Dir(imgFolder & "*.*")，再添加后缀判断逻辑。
• 形状精准筛选：如果文档里有其他形状，记得在代码里调整targetShape的获取规则，比如通过统一的形状名称来定位。
• 页面适配：如果需要更精准的形状尺寸，可以修改pageWidth和pageHeight的计算逻辑，比如调整页边距的取值。

备注：内容来源于stack exchange，提问作者Nubuki