编辑代码

Sub AddPic()
Dim CL, I&, Fn, ST&, RL&, SI
Dim W As Double, WW As Double
If Selection.Information(wdWithInTable) = True Then '在表格中则退出
    MsgBox "请选择非表格区域.", vbCritical + vbOKOnly, "警告..."
    Exit Sub
End If

CL = InputBox("请输入插入图片的列数.", "输入...")
If Not VBA.IsNumeric(CL) Then
    If CL = "" Then Exit Sub
    MsgBox "必须输入数字.", vbCritical + vbOKOnly, "警告..."
    Exit Sub
End If

If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末
    Selection.TypeParagraph '在文末添加一空段
Else
    Selection.EndKey
End If

With ActiveDocument.PageSetup
    W = (.PageWidth - .LeftMargin - .RightMargin) / CL
End With

Application.ScreenUpdating = False
With Application.FileDialog(msoFileDialogFilePicker)    '选择文件
    .InitialView = msoFileDialogViewList
    .Filters.Add "图片文件", "*.jpg,*.png,*.bmp", 1
    .AllowMultiSelect = True
    If .Show = -1 Then
    ST = .SelectedItems.Count
            RL = ((ST \ CL) + Sgn(ST Mod CL)) * 2
     
        Set SI = .SelectedItems
        Dim R&, C&, K&
        With ActiveDocument.Tables.Add(Selection.Range, RL, CL, 1, 1)    '新建表格
            .Borders.Enable = True
                For Each Fn In SI
                    K = K + 1
                    R = (K - 1) \ CL + 1    '现在行
                    C = (K - 1) Mod CL + 1      '现在列
                       With .Cell(R * 2 - 1, C).Range.InlineShapes.AddPicture(FileName:=Fn, SaveWithDocument:=True)
                        WW = .Width
                        .Width = W
                        .Height = .Height * (W / WW)
                    End With
                    .Cell(R * 2, C).Range.Text = Basename(Fn)
                Next Fn
        End With
    End If
End With
Selection.EndKey
Application.ScreenUpdating = True
MsgBox "ok", vbInformation + vbOKOnly, "提示..."
End Sub

Function Basename(FullPath) '取得文件名
Basename = Mid(FullPath, InStrRev(FullPath, "\") + 1)
Basename = Left(Basename, Len(Basename) - 4)
End Function