EXCEL VBA 文件夹操作——批量添加指定文件夹的图片

(2008-11-27 15:02:41)

转载▼

这个小程序的前提是指定的文件夹里装的全部是图片格式的文件

步骤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

程序效果：