Word VBA问题：无法将图片插入文本框内表格指定单元格

我制作的Word模板可通过UserForm输入生成报告，其他功能正常，但无法将图片插入文本框内的指定表格单元格。设置文本框是为了让用户能移动并“叠加”到文档大图上，表格用于并列放置前后对比图，表格首行标题、下方说明文字等书签内容都能正常填充。以下是尝试过的VBA代码（多种变体均无效）：

Private SelectedPhotoPath As String

Private Sub Select_Photo_Command_Button_Click()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Title = "Select a Photo"
        .InitialFileName = "C:\Desktop"
        .Filters.Clear
        .Filters.Add "Image Files", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"
        .AllowMultiSelect = False
        If .Show = -1 Then
            SelectedPhotoPath = .SelectedItems(1)
            Image_Preview.Picture = LoadPicture(SelectedPhotoPath)
        End If
    End With
    
End Sub

Sub InsertPhotoIntoTable()
Dim wdDoc As Document
    Dim tbl As Table
    Dim cell As cell
    Set wdDoc = ActiveDocument
    Set tbl = wdDoc.Tables(1) 
    Set cell = tbl.cell(Row:=2, Column:=1)
    
    ' Insert the photo into the cell
    Dim oShape As InlineShape
    Set oShape = cell.Range.InlineShapes.AddPicture(FileName:=SelectedPhotoPath, LinkToFile:=False, SaveWithDocument:=True)
    
    ' Resize the photo to fill the cell
    With oShape
        .LockAspectRatio = msoFalse
        .Width = InchesToPoints(1.5)
        .Height = InchesToPoints(1.5)
    End With

End Sub

Private Sub New_Report_Command_Button_Click()
    InsertPhotoIntoTable
End Sub

原代码核心问题是直接定位文档的第一个表格，忽略了表格位于文本框内的层级关系。Word中文本框属于Shape对象，需先定位目标文本框，再获取其中的表格。

修正后的代码如下：

Private SelectedPhotoPath As String

Private Sub Select_Photo_Command_Button_Click()
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    
    With fd
        .Title = "选择图片"
        .InitialFileName = Environ("USERPROFILE") & "\Desktop" ' 适配不同用户桌面路径
        .Filters.Clear
        .Filters.Add "图片文件", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"
        .AllowMultiSelect = False
        If .Show = -1 Then
            SelectedPhotoPath = .SelectedItems(1)
            Image_Preview.Picture = LoadPicture(SelectedPhotoPath)
        End If
    End With
End Sub

Sub InsertPhotoIntoTable()
    Dim wdDoc As Document
    Dim targetTextBox As Shape
    Dim tbl As Table
    Dim cell As Cell
    
    Set wdDoc = ActiveDocument
    
    ' 定位目标文本框（推荐按名称定位，避免索引变化）
    Set targetTextBox = wdDoc.Shapes("图片对比文本框") ' 替换为实际文本框名称
    
    ' 若不知道文本框名称，可按索引定位（示例为第一个Shape）
    ' Set targetTextBox = wdDoc.Shapes(1)
    
    ' 获取文本框内的第一个表格
    Set tbl = targetTextBox.TextFrame.TextRange.Tables(1)
    
    ' 定位到指定单元格（第2行第1列）
    Set cell = tbl.Cell(Row:=2, Column:=1)
    
    ' 插入图片并调整尺寸
    Dim oShape As InlineShape
    Set oShape = cell.Range.InlineShapes.AddPicture( _
        FileName:=SelectedPhotoPath, _
        LinkToFile:=False, _
        SaveWithDocument:=True)
    
    With oShape
        .LockAspectRatio = msoTrue ' 保持宽高比避免变形
        .Width = InchesToPoints(1.5) ' 按需调整宽度，高度自动适配
    End With
End Sub

Private Sub New_Report_Command_Button_Click()
    InsertPhotoIntoTable
End Sub

关键修正说明 #

• 层级定位：通过Shapes集合找到文本框，再通过TextFrame.TextRange获取文本框内内容，进而定位表格
• 路径适配：用Environ("USERPROFILE")替代固定路径，适配不同用户环境
• 图片比例优化：默认保持宽高比，如需固定高度可取消LockAspectRatio并设置Height
• 稳定性提升：推荐按文本框名称定位，避免文档中Shape顺序变化导致定位错误

内容的提问来源于stack exchange，提问作者Grandpa_Clem