|
23、选择一个文件夹里所有的图片，然后插入进单元格里！代码
Private Sub CommandButton1_Click()
Dim fd As FileDialog
Dim p As Shape
Dim k%, T As String
Dim k1%, i%
Application.ScreenUpdating = False '关闭屏幕更新
Set fd = Application.FileDialog(msoFileDialogFolderPicker) '允许用户选择一个文件夹,这一段最好看看帮助
With fd
If .Show = -1 Then
T = .SelectedItems(1) '选择之后就记录这个文件夹名称
Else
Exit Sub '否则就退出程序
End If
End With
For Each p In ActiveSheet.Shapes '删除本表里的所有非控件图片
If p.Type <> msoOLEControlObject Then p.Delete
Next
k = 2
k1 = 2
With Application.FileSearch '建立一个文件搜索
.LookIn = T '范围在选择的文件夹里
.SearchSubFolders = True '包含此文件夹里的文件夹（如果你选择的文件夹够大，里面图片很多，就会都选择哦）
.Filename = "*.bmp;*.cur;*.gif;*.ico;*.jpg;*.wmf" '查找类型，所有的图片格式文件，如果你操作excel表，可以用*.xls
If .Execute <> 0 Then '如果找到的图片格式文件个数不等于0的话，就
For i = 1 To .FoundFiles.Count '逐一插入图片文件
ActiveSheet.Pictures.Insert(.FoundFiles(i)).Select
Selection.Top = Cells(k, k1).Top '设置图片的顶端等于单元格的顶端
Selection.Left = Cells(k, k1).Left
Selection.Width = Cells(k, k1).Width '图片的高和宽等于单元格的高和宽
Selection.Height = Cells(k, k1).Height
k1 = k1 + 1
If k1 > 6 Then k1 = 2: k = k + 1 '在单元格里让它自动分开成5列，行数向下
Next i
End If
End With
Cells(k, k1).Select '选择最后一个单元格
Set fd = Nothing
Application.ScreenUpdating = True
End Sub
P2B0FPso.rar
(16.8 KB, 下载次数: 276)
----------------------------------------
也是图片的问题，直接链接所有的地址，主要运用heperlinks处理，下帖15楼http://club.excelhome.net/dispbb ... p;skin=0&page=1
[此贴子已经被作者于2005-9-2 13:27:10编辑过] | 
楼主: Long_III
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2005-8-25 11:52
