求助一个批量插入图片到word表格的宏

天未瞑

例：一个文件夹有4张图片，将这4张图片依次插入到一个表格的某一列里；

表格不是word已有的，可根据宏命令生成。  最终效果可见压缩包里的word

在线等，有偿求。感觉不是很难，耐何不熟悉VBA，拜谢

天未瞑

Sub 批量处理图片()
If ActiveDocument.Tables.Count = 1 Then '删除上次数据
ActiveDocument.Tables(1).Delete
End If
'//获取文件夹，存入数组
Dim kr()
Set fso = CreateObject("scripting.filesystemobject")
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then PathSht = .SelectedItems(1) Else Exit Sub
End With
Set f_num = fso.getfolder(PathSht)
For Each fl In f_num.subfolders
i = i + 1
ReDim Preserve kr(1 To i)
kr(i) = fl.Path
Next
'//开始新建表格
tbl_rowcount = UBound(kr) + Int(UBound(kr) / 3) + 1
Dim tbl As Table
Set tbl = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=tbl_rowcount, NumColumns:=4)
'新建表格
tbl.Style = "网格型"
Set tbl = ActiveDocument.Tables(1)
tbl.Columns(1).Width = 1.27 * 28.35 '设置表格各列的列宽
tbl.Columns(2).Width = 2.13 * 28.35
tbl.Columns(3).Width = 3.3 * 28.35
tbl.Columns(4).Width = 11.58 * 28.35
tbl.Rows.Alignment = wdAlignRowCenter '居中对齐
tbl.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter '文字垂直居中
'//开始插入图片
For i = 1 To tbl_rowcount
'对Word中的表格中的行进行循环。
If i Mod 4 = 1 Then '当表格的行号除以4的余数是1的时候，就是标题行。
tbl.Rows(i).Range.Font.Bold = True '字体加粗
tbl.Cell(i, 1).Range.Text = "序号"
tbl.Cell(i, 2).Range.Text = "发布形式"
tbl.Cell(i, 3).Range.Text = "线路/车牌号"
tbl.Cell(i, 4).Range.Text = "验收照片"
tbl.Rows(i).Height = 1.9 * 28.35 '设置标题行行高

Else
p = p + 1
fod_index = fod_index + 1
tbl.Cell(i, 1).Range.Text = p
tbl.Cell(i, 2).Range.Text = "司机背板"
srr = Split(kr(fod_index), "\")
tbl.Cell(i, 3).Range.Text = srr(UBound(srr))
tbl.Rows(i).Height = 6.4 * 28.35
Dim shp As InlineShape
pic = Dir(kr(fod_index) & "\*.JPG")
tbl.Cell(i, 4).Range.Select
Do While pic <> "" 'Do While循环插入图片
Set shp = Selection.Range.InlineShapes.AddPicture(FileName:=kr(fod_index) & "\" & pic)
shp.Height = 6 * 28.35
shp.Width = (10 / 2) * 28.35
pic = Dir
tbl.Cell(i, 4).Range.Select '选中该单元格，为了下一步光标定位到单元格内部
Selection.EndKey wdLine
Selection.TypeText " " '设置图片间隔
Loop

End If
Next
MsgBox "完成！"
End Sub



Function getfol()
'该函数的作用：弹出对话框提示用户选择文件夹，并且返回该文件夹路径。
'如果用户选择了取消，则返回空值
Dim PathSht As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
PathSht = .SelectedItems(1)
Else
PathSht = ""
Exit Function
End If
End With
getfol = PathSht & IIf(Right(PathSht, 1) = "\", "", "\")
End Function

这是我在网上找的一个类似功能的，但是按文件夹检索的，供参考

3190496160

先做一个wrd报个模板，不行吗？

zpy2

如果是网络图片的话，可以转成网页的形式，再另存为Word文档，比较方便。

天未瞑

有没有人给个思路啊

天未瞑

问题已解决，花钱买了个word精灵插件