求助：批量文件里的JPG格式照片生成word

ZPF2646254516

例如文件夹A下面有很多A++文件夹 每个A++文件夹下有多张jpg的图片 在每个A++文件夹里生成一个word文档 文档已A++文件夹名命名 每个word文档里放这个文件夹下的这些图片

泪眼天使

每个文件夹下新建一个Word文档，用文件夹命名，然后插入图片，可以选择全部图片插入，依次每个文件夹操作一次就可以了

ZPF2646254516

泪眼天使 发表于 2020-5-14 14:26
每个文件夹下新建一个Word文档，用文件夹命名，然后插入图片，可以选择全部图片插入，依次每个文件夹操作一 ...

有没有其他方法？

nxbai

新建一个空白的word文档。

工具——》宏——》vb编辑器——》打开this document ——》把下面代码粘入编辑窗口——》保存



打开这个word文档——》工具——》宏——》执行    下面的不用我说了，最后记得通配符批量替换照片就可以一行显示多张了。





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 = 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)

1173938421

谢谢分享

zhewin

了解一下