如何让图片和文件名都依次插入word文档

zzpsx

如附件中的word文档所示 如何让图片和文件名都依次插入word文档.rar (1.37 MB, 下载次数: 100)

2018-2-17 13:45 上传

点击文件名下载附件

leikaiyi123

  '定义一个文件选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
参考
http://club.excelhome.net/forum.php?mod=viewthread&tid=778982&extra=page%3D12&mobile=2

补充内容 (2018-2-22 20:52):
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 = 5         '在此处修改相片宽,单位厘米
                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

zzpsx

leikaiyi123 发表于 2018-2-17 17:51
'定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
参 ...

谢谢高手。

wdpfox

学习了，谢谢分享！