有些时候需要在word中大量插入图片,并且在图片下面携带本身的名称,可以用今天的代码完成。并可以自行设置图片大小。

先看效果图:

批量插入图片

其中图片大小均可自行设置。


代码完整界面

-------------------------------------------------详细代码如下-------------------------------------------------------------

Sub 批量插入图片()

Dim myfile As FileDialog

Set myfile = Application.FileDialog(msoFileDialogFilePicker)

Application.ScreenUpdating = False

With myfile

If .Show = -1 Then

For Each Fn In .SelectedItems

If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末

Selection.TypeParagraph '在文末添加一空段

Else

Selection.MoveDown

End If

Set mypic = Selection.InlineShapes.AddPicture(FileName:=Fn, SaveWithDocument:=True)

'按比例调整相片尺寸

'WidthNum = mypic.Width

c = 18 '在此处修改相片宽,单位厘米

mypic.Width = c * 28.35

mypic.Height = (c * 28.35 / WidthNum) * mypic.Height

If Selection.Start = ActiveDocument.Content.End - 1 Then '如光标在文末

Selection.InsertBreak (wdPageBreak) '在文末添加空白页

Else

Selection.MoveDown

End If

Selection.Text = Getfilename(Fn) '这两句移到这里

Selection.EndKey

Next Fn

Else

End If

End With

Set myfile = Nothing

Application.ScreenUpdating = True

End Sub

Function Getfilename(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