实现的效果：

实现的代码：

Sub InsertImageNamesAndPictures()Dim PicPath As StringDim PicName As StringDim PicFullPath As StringDim RowNum As IntegerDim Pic As ObjectDim Name As String' 防止表格里面有脏数据Cells.Clear' 遍历工作表中的每个图片并删除,防止表中有别的图片，造成叠加For Each Pic In ActiveSheet.PicturesPic.DeleteNext Pic' 修改为你的图片文件夹路径PicPath = "C:\Users\HUAWEI\Pictures\Screenshots\"' 初始化行号RowNum = 1' 获取文件夹中的第一个文件名PicName = Dir(PicPath & "*.*")' 遍历所有图片文件Do While PicName <> ""'去掉文件扩展名(即去掉文件后缀)'Name = Left(PicName, InStrRev(PicName, ".") - 1)' 将图片文件名插入到A列Cells(RowNum, 1).value = PicName' 拼接完整路径PicFullPath = PicPath & PicName' 插入图片到B列Set Pic = ActiveSheet.Pictures.Insert(PicFullPath)' 设置图片位置和大小With Pic.ShapeRange.LockAspectRatio = msoFalse.Top = Cells(RowNum, 2).Top.Left = Cells(RowNum, 2).Left.Width = 50  ' 可调整宽度.Height = 50 ' 可调整高度End With' 设置行高Rows(RowNum).RowHeight = Pic.Height' 移动到下一行RowNum = RowNum + 1' 获取下一个文件名PicName = DirLoop
End Sub

如果将下面这句话取消注释，其余的代码不变实现的效果：