如何在word中插入图片的同时插入图片的文件名
如何在word如何在word中插入图片的同时插入图片的文件如何在word中插入图片的同时插入图片的文件名名中插入图片的同时插入图片的文件名
[键入文档副标题]
kflxd
如何在word中插入图片的同时插入图片的文件名 图片放在一个文件夹里.
写代码插入WORD文件,插一张同时插上文字.
没技术含量啊. 1 Option Explicit 2 3 '----------遍历文件夹，获取文件列表 4 Public Function BsearchFile(ByVal spath As String, ByVal filesuf As String, ByRef filelist() As String) As Integer 5 Dim MyName, Dic, Did, i, T, f, TT, MyFileName, lj, Ke 6 Dim j As Integer 7 j = 0 8 lj = spath & \ 9 T = Timer 10 Set Dic = CreateObject(\创建一个字典对象 11 Set Did = CreateObject(\ 12 Dic.Add (lj), \ 13 i = 0 14 Do While i < Dic.Count 15 Ke = Dic.Keys '-----------开始遍历字典 16 MyName = Dir(Ke(i), vbDirectory) '-----------查找目录 17 Do While MyName <> \ 18 If MyName <> \ And MyName <> \ Then 19 If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then 20 Dic.Add (Ke(i) & MyName & \
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
End If End If
MyName = Dir Loop
i = i + 1 Loop
For Each Ke In Dic.Keys
MyFileName = Dir(Ke & filesuf) Do While MyFileName <> \
Did.Add (Ke & MyFileName), \ filelist(j) = Ke & MyFileName MyFileName = Dir j = j + 1 Loop Next
BsearchFile = j End Function
'-----------重复插入图片
Public Sub RepeatInsertPic(ByVal pfile As String) Dim rg As Range
Dim doc As Document
Set doc = ActiveDocument
Set rg = doc.Range(doc.Range.End - 1, doc.Range.End) rg.InsertAfter pfile & vbCrLf
Set rg = doc.Range(doc.Range.End - 1, doc.Range.End)
47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 rg.InlineShapes.AddPicture pfile
Set rg = doc.Range(doc.Range.End - 1, doc.Range.End) rg.InsertParagraphAfter Set rg = Nothing Set doc = Nothing End Sub
'----------遍历文件夹，获取文件列表
Public Function BsearchFile(ByVal spath As String, ByVal filesuf As String, ByRef filelist() As String) As Integer Dim MyName, Dic, Did, i, T, f, TT, MyFileName, lj, Ke Dim j As Integer j = 0
lj = spath & \ T = Timer
Set Dic = CreateObject(\创建一个字典对象 Set Did = CreateObject(\ Dic.Add (lj), \ i = 0
Do While i < Dic.Count
Ke = Dic.Keys '-----------开始遍历字典
MyName = Dir(Ke(i), vbDirectory) '-----------查找目录 Do While MyName <> \
If MyName <> \ And MyName <> \ Then
If (GetAttr(Ke(i) & MyName) And vbDirectory) = vbDirectory Then Dic.Add (Ke(i) & MyName & \ End If End If
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
MyName = Dir Loop
i = i + 1 Loop
For Each Ke In Dic.Keys
MyFileName = Dir(Ke & filesuf) Do While MyFileName <> \
Did.Add (Ke & MyFileName), \ filelist(j) = Ke & MyFileName MyFileName = Dir j = j + 1 Loop Next
BsearchFile = j End Function
'--------------插入图片 Sub InsertPicFromFolder() Dim spath As String
spath = \ '-----------这个图片保存路径可以自己去\改? Dim hz As String
hz = \ '-----------这里是文件通配符
Dim flist(2000) As String '----------定义数组，最多 2000个图片 Erase flist
Dim ic As Integer
ic = BsearchFile(spath, hz, flist)
99 If ic > 0 Then 100 Dim f
101 For Each f In flist
102 If VBA.Trim(f) <> \ Then Call RepeatInsertPic(f) 103 Next
104 MsgBox \插入\ & ic & \张图片成功，请检查！\105 Else
106 MsgBox \路径下无图片文件，请检查！\提示\ 107 End If 108 End Sub
提示\