如何用EXCEL 批量插入 同一个文件夹中 全部图片?最好能够在下面出现文件

首先需要excel加载项中选择DIY工具箱，选择导入图片功能；在弹出的对话框中选择添加按钮；找到图片路径，全选需要导入的图片，然后点击打开；在弹出的对话框中，设置需要储存的单元格，以及导入格式。关键的步骤就是选中同时标注图片名功能，然后点击确认。点击取消关闭对话框在表格中我们就把图片和图片名一一对应上了。

Sub InsertPic()
Dim i As Long, sPath As String, sfileName As String
s360问答Path = "D:\pic\"
***.screenupdating = False
On Error Resume Next
With ***.sheets("Sheet1")
For i = 1 To 256
If .Cells(1, i) <> "" Then
sfileName = sPath & .Cells(1, i) & ".jpg"
Cells(2, i).Select
.***.insert (sfileName)
If Err <> 0 Then
MsgBox .Cell日菜远s(1, i) & ".jpg" & "不存在"
Err = 0
End If
End If
Next i
End With
***.screenupdating = True
Range("A1").Select
End Sub

Sub InsertPicture()
Dim MyShape As Shape
Dim r As Integer
Dim c As Integer
Dim PicPath As String
Dim Picrng As Range
With Sheet1
For Each MyShape In .Shapes
If MyShape.Type = 13 Then
MyShape.Delete
End If
Next
For r = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
For c = 1 To 8 Step 2
PicPath = ThisWorkbook.Path & "\" & .Cells(r, c).Text & ".jpg"
If Dir(PicPath) <> "" Then
Set MyShape = .Shapes.AddPicture(PicPath, False, True, 6, 6, 6, 6)
Set Picrng = .Cells(r, c + 1)
With MyShape
.LockAspectRatio = msoFalse
.Top = Picrng.Top + 1
.Left = Picrng.Left + 1
.Width = Picrng.Width - 1.5
.Height = Picrng.Height - 1.5
.TopLeftCell = ""
End With
Else
.Cells(r, c + 1) = "暂无照片"
End If
Next
Next
End With
Set MyShape = Nothing
Set Picrng = Nothing
End Sub
效果如下图：