这个小程序的前提是指定的文件夹里装的全部是图片格式的文件
步骤1:
添加一个filesystemobject引用,工具--->引用---->microsoft
scripting runtime
步骤2:
添加模块,并添加以下代码
Option Explicit
'设置单元格大小,单元格大小设置因人而异,设置数量要大于或者等于文件夹图片数量,这里范围为range("a1:h10")的单元格的大小
Sub changecell()
Dim r As Integer, c As Integer
For r = 1 To 10
For c = 1 To
8
With Sheet1.Cells(r, c)
.RowHeight = 100
.ColumnWidth = 15
End With
Next c
Next r
End Sub
'添加图像
Sub addpic()
Dim fso As Scripting.FileSystemObject
Dim file As file, files As files
Dim picname()
Dim i As Integer
Dim rng As Range
Set fso = New Scripting.FileSystemObject
Set files = fso.GetFolder("F:\My Pictures\").files
ReDim picname(files.Count)
For Each file In files
i = i +
1
picname(i) =
file.Path
Next
i = 1
For Each rng In Sheet1.Range("a1:h10")
With
rng
Sheet1.Shapes.AddPicture picname(i), msoTrue, msoTrue, .Left, .Top,
.Width, .Height
End
With
i = i +
1
Next
End Sub
'删除图像
Sub deletepic()
Dim i As Integer
For i = 1 To Sheet1.Shapes.Count
Sheet1.Shapes(1).Delete
Next
End Sub
程序效果:

|