【代工案例001】Word VBA批量插入图片

▎具体需求

手里面有上千个文件夹，每个文件夹里面包含2张照片，我们需要把这些图片插入到word文档的表格中。每3个文件夹作为一页。

文件夹示意

文件夹内部图片

最终效果

▎思路分析

首先需要获取文件夹的个数，根据文件夹个数确定一下word文档的表格总行数。接着插入空的表格，向表格里面写内容，并且插入图片。

▎源代码

实现功能的源代码在下方，由于文件隐私，不再推送原始附件。可以从下面的源代码中获取思路。

    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 With getfol = PathSht & IIf(Right(PathSht, 1) = "\", "", "\")End Function

    ▎知识点

    • 获取子文件夹

      利用FSO对象，获取子文件夹，这个代码很常用。

      Set fso = CreateObject("scripting.filesystemobject")Set f_num = fso.getfolder(PathSht)For Each fl In f_num.subfolders msgbox fl.nameNext

      • Word VBA新建表格

      Word VBA中很大一部分代码，都可以通过录制宏获取。比如下方的代码。

        Sub Add_table()'新建一个3行4列的表格 Set tbl = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=3, NumColumns:=4) tbl.Style = "网格型"End Sub

        • Word中的单位

          行高列宽默认是磅。如果是厘米，需要转化一下。转化关系如下：

          1磅约等于0.03527厘米,1厘米约等于28.35磅。

        赞 (0)

        相关推荐