工作任务急需高手支招：把工作薄文件夹下照片批量导入到表格指定单元格

jiang_619

把工作薄文件夹下照片批量导入到表格指定单元格：（本单位管理3000多户零售户，有9000多张客户照片信息需要导入表中相应区域）详见附件 零售户摸底表格示例.zip (9.63 KB, 下载次数: 21)

2013-3-26 10:05 上传

点击文件名下载附件
示例

说明：
1、“客户档案”表中有多户客户的各项资料，除3张照片未完成粘贴外其余均已经填写到表格中。
2、3张照片分别是1区的法人照片，2区的门面照片，3区的柜台照片
3、照片的命名规则分别是：法人照片=C4单元格的许可证号+FR.jpg、门面照片=C4单元格的许可证号+MM.jpg、柜台照片=C4单元格的许可证号+GT.jpg
任务要求：
制作宏代码，批量将文件夹中有客户相关照片的粘贴到相应区域，没有照片的显示“缺失照片信息”字样
我是代码盲，工作任务紧，求高手帮忙，感激不尽！！！

jiang_619

帮忙看看代码哪出错了？运行到“ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & zhenhao & "FR.jpg").Select”时中止。
Sub 批量填充客户3项照片()
' 宏由 jiang_619 录制，时间: 2013-3-26
'
Dim i As Integer
Dim fr As Integer
Dim mm As Integer
Dim gt As Integer
Dim zhenhao As Integer

For i = 1 To 300
zhenhao = i * 15 - 11
fr = i * 15 - 12
mm = i * 15 - 12
gt = i * 15 - 6

Range("t" & fr).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & zhenhao & "FR.jpg").Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 147
    Selection.ShapeRange.Width = 88
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.73, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.24, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft
Range("y" & mm).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & zhenhao & "MM.jpg").Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 294
    Selection.ShapeRange.Width = 440
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.73, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.24, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft
Range("y" & gt).Select
ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & zhenhao & "GT.jpg").Select
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.Height = 294
    Selection.ShapeRange.Width = 440
    Selection.ShapeRange.Rotation = 0#
    Selection.ShapeRange.ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.73, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.24, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft
Next i
End Sub

jiang_619

找到解答了，但不明白代码中这几行的意思，为什么贴的照片宽度和高度都跟设置的像素小了一半？
    Selection.ShapeRange.LockAspectRatio = msoTrue
     Selection.ShapeRange.Height = 294
     Selection.ShapeRange.Width = 440
     Selection.ShapeRange.Rotation = 0#
     Selection.ShapeRange.ScaleWidth 0.73, msoFalse, msoScaleFromTopLeft
     Selection.ShapeRange.ScaleHeight 0.73, msoFalse, msoScaleFromTopLeft
     Selection.ShapeRange.ScaleHeight 0.24, msoFalse, msoScaleFromTopLeft
     Selection.ShapeRange.ScaleHeight 2.5, msoFalse, msoScaleFromTopLeft

grf1973

你要在当前文件下建个“图片”的文件夹，然后把所有图片放在里面。我原来做了三张图片，压缩后太大，删掉了一张。你自己试试吧。

jiang_619

收到，效果非常不错！谢谢高手帮忙解决。{:soso_e183:}

i659

下回来认真学习一下

寶瓶

学习一下