如何把某文件夹下所有图片都插入到一个Excel中的某个sheet中？

bo0502wang

各位，我有个可能比较简单的问题，如何把某文件夹(假设是D:\杂件\)下所有图片以同样的长款插入到一个Excel中的某个sheet中？
不需要对照文件名什么的，也不一定要放到某个具体的单元格里，只要把所有图片都插入进来就可以了，接下来把图片放在那个单元格里，需要操作者自己的职业判断的，这部分VBA做不了。最好插入的图片能够等宽等高，放在sheet1 的M列的靠上的为止附近即可，方便拖拽。我试着录了宏，可是录下来的代码我看不懂......

我没有附附件，因为不涉及数据。麻烦大家帮我看看，如果您没时间写代码，给我提示一下可能有用的语句也可，我自己研究下。谢谢大家：）

jpj123

选择插入的图片时按CTRL+A键，全部选中，点插入就OK 了。

爱疯

Sub test()
    Dim path$, file$, i%
    Application.ScreenUpdating = False
    Call delPic
    path = ThisWorkbook.path & "\pics\"
    file = Dir(path)
    Do While file <> ""
        i = i + 1
'        Call rangeSize(path, file, Cells(i, 1))
        Call picSize(path, file, Cells(i, 1))
        file = Dir
    Loop
End Sub
'
Sub delPic()
    ActiveSheet.Pictures.Delete
End Sub
'
'按单元格大小导入
Sub rangeSize(path As String, file As String, rng As Range)
    With rng
        ActiveSheet.Shapes.AddPicture _
                Filename:=path & file, LinkToFile:=True, SaveWithDocument:=True, _
                Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height
    End With
End Sub
'
'按图片大小导入
Sub picSize(path As String, file As String, rng As Range)
    With ActiveSheet.Pictures.Insert(path & file)
        '系统限制行高最大值409磅
        If .Height < 410 Then rng.RowHeight = .Height Else MsgBox "图片行高超出限制。": End
        '图片左上对齐单元格左上
        .Left = rng.Left: .Top = rng.Top
        '修改区域一列的列宽。从磅转为字符数
        rng.ColumnWidth = (.Width * 96 / 72 - 5) / 8
    End With
End Sub
导入图片到工作表_4楼.rar (21 KB, 下载次数: 119)

2014-11-24 10:06 上传

点击文件名下载附件

386026398

爱疯 发表于 2014-11-24 10:07
Sub test()
    Dim path$, file$, i%
    Application.ScreenUpdating = False

按顺序导入即可，程序怎么修改呢