Excel VBA代码：批量插入指定目录下指定类型所有图片

批量插入指定目录下指定类型所有图片Excel VBA代码：

Sub insertimg()

””””””””””””””””””””””'

‘ 批量插入指定目录下所有指定类型图片 ‘

‘ ‘

””””””””””””””””””””””'

Dim mypath As String, nm As String

Dim theSh As Object

Dim theFolder As Object

Dim i As Integer

Application.ScreenUpdating = False ‘关闭屏幕更新

On Error Resume Next

‘设置搜索路径

Set theSh = CreateObject("shell.application")

Set theFolder = theSh.BrowseForFolder(0, "", 0, "")

If Not theFolder Is Nothing Then

mypath = theFolder.Items.Item.Path

End If

‘//////////////搜索并插入图片开始////////////////

nm = Dir(mypath & "\*.jpg")

‘第一次使用dir，必须指定pathname参数，返回符合条件的第1个文件名，修改扩展名可以查其它文件类型。

Do While nm <> ""

With Range("a" & i + 1)

ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Select

Selection.ShapeRange.Fill.UserPicture mypath & "\" & nm ‘插入图片

End With

i = i + 1

nm = Dir ‘再次调用不需要pathname参数

Loop

Set sh = Nothing ‘释放内存

Set theFolder = Nothing ‘释放内存

Application.ScreenUpdating = True ‘开启屏幕更新

End Sub