(2008-11-27 15:02:41)
轉載▼這個小程序的前提是指定的文件夾里裝的全部是圖片格式的文件
步驟1:
添加一個filesystemobject引用,工具--->引用---->microsoft scripting runtime
步驟2:
添加模塊,并添加以下代碼
Option Explicit
'設置單元格大小,單元格大小設置因人而異,設置數(shù)量要大于或者等于文件夾圖片數(shù)量,這里范圍為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
程序效果:
本站僅提供存儲服務,所有內(nèi)容均由用戶發(fā)布,如發(fā)現(xiàn)有害或侵權內(nèi)容,請
點擊舉報。