Excel 利用宏插入URL链接的图片和图片按名字保存到文件夹功能加强

嬲你

在excelhome上得到不少的帮助，借此机会谢谢大家！
附近有几个问题想向各位请教。望大家不吝赐教。

• 插入URL链接的图片。
  

• 问题1：URL含错误地址的话就出错
• 想改成按选择区域来获取 同时判断URL是不是含有图片，被插入的位置是不是已经存在图片如果存在就跳过。
  

• 导出图片
  

• 导出图片的宏在Sheet内可用。但是在 模块中 不可用，应该怎么改？
• 导出的图片比较小，而且带黑色边框。是否可以直接copy原图（也就是重设大小后的图片）
  

1. Sub Export_Picture() '图片批量导出保存并重命名某一列数据为图片文件名
   
2. Application.ScreenUpdating = False
   
3. On Error Resume Next
   
4. MkDir ThisWorkbook.Path & "\images"
   
5. For Each Pic In Shapes
   
6. If Pic.Type = msoPicture Then
   
7. RN = Pic.TopLeftCell.Offset(0, -1).Value '重命名图片
   
8. Pic.Copy
   
9. With ActiveSheet.ChartObjects.Add(0, 0, Pic.Width, Pic.Height).Chart '创建图片
   
10. .Paste
    
11. .Export ThisWorkbook.Path & "\images" & RN & ".jpg"
    
12. .Parent.Delete
    
13. End With
    
14. End If
    
15. Next
    
16. 'MsgBox "Exporting the picture is complete!" '导出图片完成！
    
17. Application.ScreenUpdating = True
    
18. Shell "explorer.exe " & ThisWorkbook.Path & "\images", vbNormalFocus '打开文件夹！
    
19. End Sub
    
20. 
    
21. Sub addPicture_Url()
    
22. Dim z As Shape, e$, i%
    
23. Set PicUrlCol = Application.InputBox("Select URL Column", Title:="Images Name Column", Type:=8)
    
24. PicCol = PicUrlCol.Column '取图片URL所在列列列标
    
25. Set TPnameCol = Application.InputBox("请选择图片需要放置的列，只能选择单列单元格！", Title:="图片所在列", Type:=8)
    
26. TPCol = TPnameCol.Column '取图片所在列列列标
    
27.     For i = 1 To Cells(Rows.Count, PicCol).End(3).Row
    
28.         e = Cells(i, PicCol)
    
29.         If e <> "" Then
    
30.              Set z = ActiveSheet.Shapes.addpicture(e, True, True, Cells(i, TPCol).Left, Cells(i, TPCol).Top, Cells(i, TPCol).Width, Cells(i, TPCol).Height) '调整图片大小和单元格一样
    
31.         End If
    
32.     Next
    
33. End Sub
    
34. 
    

复制代码

嬲你

自己占个沙发，声明一下 用户民是多年前在百度上查这个字的时候顺手取的，然后就改不了了，真没有恶意。嬲（niǎo）：方言用字，很多时候用作脏词。通孬。在普通话中意为戏弄、搅扰，或纠缠之意。在内蒙古以及晋北方言中，意为：神气、得意，或志得意满之意。粤语中意为：生气。

约定的童话

写在sheet一样用啊，黑边框估计你插入了shapepicture，换用insert直接插入，这种玩法分为两大步：①先把地址变成超链接②采用insert直接插入，然后设置尺寸即可！