【原】Excel中几百个网址，如何一键转换成图片？

▎具体需求

A列有成千上百个网址，每个网址代表一个图片的地址。需要把这些网址中的图片批量插入到右侧的单元格中。

▎思路分析

• 网址转换成本地图片文件
  

       借助API函数URLDownloadToFile可实现该效果。该函数作用：从指定             URL地址读取内容并将读取到的内容保存到特定的文件。

• 插入图片到单元格

  采用AddPicture或者Insert方法，批量插入图片到单元格 。

  注意两者有区别，Insert方法插入的图片仅仅是图片链接，而不是图片源文件。如果图片位置发生改变，则Excel文件中看不到该图片。
  

▎源代码

下载并插入图片：

Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As LongPublic Sub downloadandshow()'下载并插入图片 Application.ScreenUpdating = False Dim iRow, i, s Dim savePath Dim arr As Variant Set fso = CreateObject("scripting.filesystemobject") '图片会存放到excel同一个位置下的图片文件夹中,可以自己修改名称 savePath = ThisWorkbook.Path & "\图片" If fso.folderexists(savePath) Then fso.deletefolder savePath End If MkDir savePath i = 2 'cell(i,1)代表将图片链接存在第i行第1列中 Do While Cells(i, 1) <> "" URLDownloadToFile 0, Cells(i, 1).Value, savePath & "\" & i & ".jpg", 0, 0 'cell(i,1)将生成的图片放在那里 Cells(i, 2).Select Cells(i, 2).RowHeight = 100 Cells(i, 2).ColumnWidth = 30 ActiveSheet.Pictures.Insert(savePath & "\" & i & ".jpg").Select Selection.ShapeRange.LockAspectRatio = msoFalse '设置图片的高度和宽度 Selection.ShapeRange.Height = Cells(i, 2).Height Selection.ShapeRange.Width = Cells(i, 2).Width i = i + 1 Loop Application.ScreenUpdating = TrueEnd Sub

清空上次的图片：

Sub 清除图片() Dim shp As Shape    For Each shp In ActiveSheet.Shapes If shp.Type = 11 Then shp.Delete End If Next Cells.RowHeight = 15End Sub

▎关于代工

目前主业工作之外，休息时间我也会做一些VBA定制补贴家用。目前的客户主要是朋友介绍和一些公众号来的朋友，相比淘宝没有任何中间商，单子价格都比较实惠，单子数量也在成上升趋势。

我做单子，有个原则。500以内的单子，除非客户主动给我发红包，我都是做完发给客户测试没问题，我再收红包。可是最近遇到一个不太诚信的朋友，令人很郁闷。收完文件，直接删除好友了。

虽然价格不高，但是这种行为让我很是郁闷。我已发短信告知此人，仍没有得到回复。在此公开此人信息，代工同行们遇到谨慎。

微信号：qq13761355754

手机号：[phone]

没错，就是下面这位：

qq头像