有些时候需要在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