如何将图片批量导入word中并附加文件名(源代码)

【#文档大全网# 导语】以下是®文档大全网的小编为您整理的《如何将图片批量导入word中并附加文件名(源代码)》，欢迎阅读！



【目标任务】：

现有多张图片，需插入一个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.wddqxz.cn/f7715aa465ec102de2bd960590c69ec3d5bbdbef.html