如何在word中插入图片的同时插入图片的文件名

如何在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

提示\

本文来源：https://www.bwwdw.com/article/qc87.html