如何将图片批量导入word中并附加文件名

　　如何将图片批量导入word中并附加文件名？其实只要活用word的“宏”这一功能就好了，下面为大家详细讲解。

　　新建一个空白的word文档。

　　工具——》宏——》vb编辑器——》打开this document ——》把下面代码粘入编辑窗口——》保存

　　打开这个word文档——》工具——》宏——》执行

　　下面的不用我说了，最后记得通配符批量替换照片就可以一行显示多张了。

　　Sub InsertPic()
　　     Dim myfile As FileDialog
　　     Set myfile = Application.FileDialog(msoFileDialogFilePicker)
　　     With myfile
　　         .InitialFileName = "F:\"
　　         If .Show = -1 Then
　　             For Each fn In .SelectedItems
　　                 Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True)
　　                 '按比例调整相片尺寸
　　                 WidthNum = mypic.Width
　　                 c = 20         '在此处修改相片宽,单位厘米
　　                 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

责任编辑：Agent