批量插入图片并调整大小

roych

       其实，这是俺在百度知道里回答的问题（O(∩_∩)O~，俺凭这个换取了一个百度水晶鼠标送给朋友了）。不过想来对大家有所帮助，就发在这里了。

1. Sub test()
   
2. '定义一个文件对话框以获取文件
   
3. Dim fd As FileDialog
   
4. '定义获取文件名的字符串
   
5. Dim fn As String
   
6. '设置为文件拾取器
   
7. Set fd = Application.FileDialog(msoFileDialogFilePicker)
   
8. With fd
   
9. '定义按钮名称和对话框标题，并设置为允许多重选择以达到批量完成的效果
   
10. .ButtonName = "浏览"
    
11. .Title = "请浏览图片文件"
    
12. .AllowMultiSelect = True
    
13. '清空全部格式，增加图片格式以免用户插入不合法的文件。
    
14. .Filters.Clear
    
15. .Filters.Add "支持的图片文件（*.JPG,*.PNG,*.GIF,*.TIFF,*.JPEG,*.BMP）", "*.JPG,*.PNG,*.GIF,*.TIFF,*.JPEG,*.BMP"
    
16. If .Show = -1 Then
    
17. '选择后，开始计算所选文件个数，并选择F1为图片插入初始单元格。如有需要，请自行改动。
    
18. For i = 1 To .SelectedItems.Count
    
19. fn = .SelectedItems(i)
    
20. Sheets(1).Range("F" & i).Select
    
21. '设置标准横高和列宽。请先插入一张图片，根据实际需要设置。
    
22. Selection.RowHeight = 89.25
    
23. Selection.ColumnWidth = 18.88
    
24. '选择并调整图片位置
    
25. ActiveSheet.Pictures.Insert(fn).Select
    
26. Selection.ShapeRange.IncrementLeft 2
    
27. Selection.ShapeRange.IncrementTop 2
    
28. '取消纵横比，以便设置所有图片大小一致。
    
29. Selection.ShapeRange.LockAspectRatio = 0
    
30. Selection.ShapeRange.Width = 112
    
31. Selection.ShapeRange.Height = 85
    
32. Next
    
33. End If
    
34. End With
    
35. End Sub

复制代码

大家喜欢的话就下载下来玩玩吧。

游客，如果您要查看本帖隐藏内容请回复

应2L的要求，加上了文件名。主要用InstrRev函数和Mid函数，基本就可以截取到文件名字符串了。
-----------------------------------------------------------------------
2016-03-29 更新：
增加2007版本
PS：微软挖了一个大坑。2007版本以上取消了Pictures集合，改为shapes.AddPicutrue了。

roych

joyark 发表于 2011-4-24 03:21
回复 roych 的帖子

如果把,自動把圖片名稱一起寫入更好

用fn（文件名字符串）很容易提取文件名的。。。详见更新后的附件。

roych

回复 joyark 的帖子

1、2003版本部分对象或者方法可能在2007版本里已经没有了（刚刚在2007录制宏后，发现没有相应的代码）。但2007版本可以打开2003版本，如果不希望2007弹出安全信息提示的话，可以处理完后再删除宏，另存文件即可。
2、3将里面的相应的代码修改成：
                    Sheets(1).Range("E" & i+2) = Mid(fn, InStrRev(fn, "\") + 1, InStrRev(fn, ".") - InStrRev(fn, "\"))
                    Sheets(1).Range("F" & i+2).Select

roych

回复 pureshadow 的帖子

截几个屏，写点嘛，小妖姐姐……汉字我还是看得懂滴。

roych

joyark 发表于 2011-4-24 05:19
回复 roych 的帖子

1.常試過2003可以2007不可以

在选中单元格的前提下，Office 2010（俺用的是英文正版，详见视频录像）是可以用滴。如果出现无法对齐的情况，请删除原先所有图片，点选单元格后再点击按钮试试

roych

回复 joyark 的帖子

O(∩_∩)O~，你稍稍改改应该就很好了，我就不处理啦。。

roych

Losers 发表于 2011-10-29 16:56
该如何用，详细操作用么

按下Alt+F8调出宏界面，点击运行即可。以下为2010英文本操作界面：

点击里面的运行（Run）

你可能需要先对VBA有所了解再看这个帖子可能会好些。或者看看小妖在回帖中的Excel技巧。

roych

feifeiwuheng 发表于 2012-1-17 08:24
请问，怎么让图片成横排的排列呢，名称在图片的下面呢?  谢谢！

类似地，只是把插入位置改改就好了。具体需要看实际需要而定。

roych

licho 发表于 2013-3-8 15:39
刚在网上发了类似的主题,不知会被管理员

发布什么主题？广告贴常常是删无赦并禁言的。

roych

koutx 发表于 2017-1-6 20:44
图纸插入，调整大小，清晰度等，都是糜麻烦事啊。

既然是批量插入，肯定是要规定好一些必要的规格的了。就好比证件照，不可能允许你随意上传一个自拍照来制作的。
同样地，在实际工作中，例如，制作工卡时人事行政部就应该规范下来，要求员工提交什么样的照片。。。

另外，批量操作，从来是用数量换质量的做法，对于细节的讲究往往不会太讲究。在这两者之间达到一个可以接受的平衡点就好了。