Word宏批量添加图片到文档并在图片下方添加图片文件名

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