【目标任务】： 现有多张图片，需插入一个Word文件中，要求图片大小一致，并显示图片文件的名称。如果手动操作，非常费时费力，且效果不好，难以做到每张图片大小一致。快速实现此功能的方法如下： 【操作方法】： 新建一个空白的word文档。 工具——宏——vb编辑器——打开this document ——把下面代码粘入编辑窗口——保存 打开这个word文档——工具——宏——执行 下面的不用我说了，最后记得通配符批量替换照片就可以一行显示多张了。 Sub InsertPic() Dim myfile As FileDialog Set myfile = Application.FileDialog(msoFileDialogFilePicker) With myfile .InitialFileName = C001 If .Show = -1 Then For Each fn In .SelectedItems Set mypic = Selection.InlineShapes.AddPicture(FileName=fn, SaveWithDocument=True) '按比例调整相片尺寸 WidthNum = mypic.Width c = 15 '在此处修改相片宽,单位厘米 mypic.Width = c 28.35 mypic.Height = (c 28.35 WidthNum) mypic.Height If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末 Selection.TypeParagraph '在文末添加一空段 Else Selection.MoveDown End If Selection.Text = Basename(fn) '函数取得文件名 Selection.EndKey If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末 Selection.TypeParagraph '在文末添加一空段 Else Selection.MoveDown End If Next fn Else End If End With Set myfile = Nothing End Sub Function Basename(FullPath) '取得文件名 Dim x, y Dim tmpstring tmpstring = FullPath x = Len(FullPath) For y = x To 1 Step -1 If Mid(FullPath, y, 1) = Or _ Mid(FullPath, y, 1) = Or _ Mid(FullPath, y, 1) = Then tmpstring = Mid(FullPath, y + 1) Exit For End If Next Basename = Left(tmpstring, Len(tmpstring) - 4) End Function 本文来源：https://www.wddqw.com/doc/f7715aa465ec102de2bd960590c69ec3d5bbdbef.html