WORD 批量导入图片以及文件名称
对于WORD以及WPS文字都有自己的插入图片的功能，不过上述的功能无法把各自的文件名也批量导入。以下时解决方法，适用于WORD，目前不支持WPS文字。
代码
Sub 插入图片() Dim myfile As FileDialog Set myfile = Application.FileDialog(msoFileDialogFilePicker) With myfile .InitialFileName = "C:\" If .Show = -1 Then For Each fn In .SelectedItems Selection.TypeParagraph '在文末添加一空段 Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True) mypic.Width = 700 '根据需要设置 mypic.Height = 433 If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末 Selection.TypeParagraph '在文末添加一空段 Else Selection.MoveDown End If Selection.Text = Basename(fn) '函数取得文件名 Selection.EndKey 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
上述代码中：
.InitialFileName = "C:\" 代表初始目录；
mypic.Width = 700 图片的宽度
mypic.Height = 433 图片的高度
Selection.TypeParagraph 在文末添加一空段
Set mypic = Selection.InlineShapes.AddPicture(FileName:=fn, SaveWithDocument:=True) 插入图片
上述宽度与高度适合16：9图片，横版，页边距 上下 2.0 左右 2.35 。
您阅读本篇文章共花了： 