批量插入图片的VBA

greenboater

一个文件夹下面有N个文件夹
需要把各个文件夹里的图片都插入到word中

先插入“文件夹”的名称，格式为“1级标题”
再插入文件夹下”图片“的名称，格式为”2级标题“
最后再插入”图片“,格式为”正文“
最终效果如文件夹下的word
先感谢大侠了！！


test.rar (706.52 KB, 下载次数: 16)

2014-6-17 17:23 上传

点击文件名下载附件

网上找着插入一个文件夹下图片的代码，供参考

1. Sub 批量插入图片()
   
2.     Dim myfile As FileDialog
   
3.     Set myfile = Application.FileDialog(msoFileDialogFilePicker)
   
4.     With myfile
   
5.         .InitialFileName = "D:\111"
   
6.         If .Show = -1 Then
   
7.             For Each Fn In .SelectedItems
   
8.                 Selection.Text = Basename(Fn)    '这两句移到这里
   
9.                 Selection.EndKey
   
10.                 If Selection.Start = ActiveDocument.Content.End - 1 Then  '如光标在文末
    
11.                     Selection.TypeParagraph    '在文末添加一空段
    
12.                 Else
    
13.                     Selection.MoveDown
    
14.                 End If
    
15. 
    
16.                 Set mypic = Selection.InlineShapes.AddPicture(FileName:=Fn, SaveWithDocument:=True)
    
17.                 '按比例调整相片尺寸
    
18.                 WidthNum = mypic.Width
    
19.                 c = 18         '在此处修改相片宽,单位厘米
    
20.                 mypic.Width = c * 28.35
    
21.                 mypic.Height = (c * 28.35 / WidthNum) * mypic.Height
    
22.                 If Selection.Start = ActiveDocument.Content.End - 1 Then  '如光标在文末
    
23.                     Selection.TypeParagraph    '在文末添加一空段
    
24.                 Else
    
25.                     Selection.MoveDown
    
26.                 End If
    
27.             Next Fn
    
28.         Else
    
29.         End If
    
30.     End With
    
31.     Set myfile = Nothing
    
32. End Sub
    
33. Function Basename(FullPath)    '取得文件名
    
34.     Dim x, y
    
35.     Dim tmpstring
    
36.     tmpstring = FullPath
    
37.     x = Len(FullPath)
    
38.     For y = x To 1 Step -1
    
39.         If Mid(FullPath, y, 1) = "" Or _
    
40.            Mid(FullPath, y, 1) = ":" Or _
    
41.            Mid(FullPath, y, 1) = "/" Then
    
42.             tmpstring = Mid(FullPath, y + 1)
    
43.             Exit For
    
44.         End If
    
45.     Next
    
46.     Basename = Left(tmpstring, Len(tmpstring) - 4)
    
47. End Function

复制代码

greenboater

没有人知道吗？？

greenboater

rererererererererererererererererererererererererere