使用宏批量插入图片到Word表格

创建宏，word 视图-》宏》查看宏》输入名称》创建

 宏代码如下：

Sub imgTbl()If ActiveDocument.Tables.Count = 1 Then '删除上次数据ActiveDocument.Tables(1).DeleteEnd If'//获取文件夹，存入数组Dim kr()Set fso = CreateObject("scripting.filesystemobject")With Application.FileDialog(msoFileDialogFolderPicker)If .Show Then PathSht = .SelectedItems(1) Else Exit SubEnd WithDim imgPaths()  '图片路径数组picName = Dir(PathSht & "\*.bmp")Do While picName <> "" 'Do While循环i = i + 1imgPath = PathSht + "\" + picNamepicName = Dir    ' 查找下一个图片ReDim Preserve imgPaths(1 To i)imgPaths(i) = imgPathLoopimgNum = UBound(imgPaths) + 1Dim value '弹出输入框，输入列数，默认10，会自动计算行数value = InputBox("请输入表格列数", "表格列数", "10")Debug.Print valuetbl_columnNum = valuetbl_rowNum = Int(imgNum / tbl_columnNum) + 1'//开始新建表格Dim tbl As TableSet tbl = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=tbl_rowNum, NumColumns:=tbl_columnNum)'新建表格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.Rows(1).Height = 2.13 * 28.35 '设置表格各列的列宽tbl.Rows.Alignment = wdAlignRowCenter '居中对齐tbl.Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter '文字垂直居中'tbl.Range.HorizontalInVertical = xlHAlignCenter '文字水平居中'tbl.Range.Rows.Alignment = wdAlignRowCentertbl.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter '文字水平居中tbl.Range.Font.Size = 6'//开始插入图片For i = 1 To tbl_rowNum'对Word中的表格中的行进行循环。For j = 1 To tbl_columnNum'对Word中的表格中的列进行循环。fod_index = fod_index + 1If fod_index >= imgNum Then ' 超过图片数量，退出循环Exit ForEnd IfimgPath = imgPaths(fod_index) '图片路径srr = Split(imgPath, "\")FullName = srr(UBound(srr))nrr = Split(FullName, ".")'tbl.Cell(i, j).Range.Text = nrr(0) '单元格文字图片名称不带后缀'tbl.Cell(i, j).Range.Text = "OK"tbl.Cell(i, j).Range.Select  '选择当前单元格Dim shp As InlineShapeSet shp = Selection.Range.InlineShapes.AddPicture(FileName:=imgPath) '插入图片tbl.Cell(i, j).Range.Select  '选择当前单元格 '选中该单元格，为了下一步光标定位到单元格内部Selection.EndKey wdLineSelection.TypeText Chr(10) & nrr(0)   '单元格文字图片名称不带后缀NextNextMsgBox "完成！"
End SubFunction getfol()
'该函数的作用：弹出对话框提示用户选择文件夹，并且返回该文件夹路径。
'如果用户选择了取消，则返回空值Dim PathSht As StringWith Application.FileDialog(msoFileDialogFolderPicker)If .Show ThenPathSht = .SelectedItems(1)ElsePathSht = ""Exit FunctionEnd Withgetfol = PathSht & IIf(Right(PathSht, 1) = "\", "", "\")
End Function

新建窗体：

 点击按钮执行宏，代码：

Private Sub CommandButton1_Click()Application.Run MacroName:="imgTbl"
End Sub

Word打开显示窗体，代码：

Private Sub Document_Open()UserForm1.Show  '显示用户窗体
End Sub

执行效果：