唠嗑老掉牙的一小段
我第一次对 EXcel 有感觉，应该是早些年在富士康实践的时候。那时候是在 FQC 岗位做事，有次在过年值夜班比较闲的时候，用了 Excel 做了个工资的计算，其中是利用了 Excel 一些简单的公式来计算的。那时候还很年轻，这个小小的作品也感到小小的喜悦，因为做出来，好多同事也用上了。（那时候工作的电脑只能查看内部网的“新闻”，手机也只能一些干部携带到工作区，数据的拷贝还是用的软盘，没错，就是存储容量1到2 m 容量的软盘）
这应该是我第一次间接地爱恋了 VBA（Visual Basic for Applications） 吧。
问题的应用场景
最近我们做了个导出数据表报，其中报表中有图片。考虑到直接在服务器上下载图片并把图片塞到报表中，然后生成文件返回，这样对服务器的内存资源有很大的消耗，我们考虑在客户端实现图片的下载并放置到报表中。
于是我开始看了Excel 的 VBA （Visual Basic for Applications）。这应该就是我和 VBA 阔别多年的第一次约会了。
VBA 实现Excel的图片下载操作。
查阅了两天的资料，我简单的实现了根据 Excel 表中的某列值（图片链接）下载图片放置到对应行的某列中。
实现思路是：1、遍历 Excel 表中的图片链接列，拿到图片链接；
2、下载图片，把图片文件临时保存到本地磁盘中；
3、将图片插入到 Excel 的图层中，调整图片的位置以及大小
实现效果
原始报表
在客户端下载图片
VBA 代码
思路简单，代码实现也简单（原始初级low），上代码
1 'download the picture from net 2 'by wmy at 2018/05/14 3 Option Explicit 4 Public isLoadImage As Boolean 5 6 '必须控件：按钮【CommandButton1】，按钮控件的名称为：CommandButton1 7 '使用说明：根据 【图片地址列】 去下载网络图片，放置到对应行的 【下载图片即将放置列】 8 ' 根据报表需求，对应修改 【图片地址列】和 【下载图片即将放置列】 9 ' 对应参数为：imgUrlColumIdx，imgColumIdx 10 Private Sub CommandButton1_Click() 11 Dim txtUrl As String 12 Dim loadTag As String 13 Dim Asheet As Worksheet 14 Dim r As Integer 15 Dim i As Integer 16 Dim imgUrlColumIdx As Integer 17 Dim imgColumIdx As Integer 18 r = Sheet1.UsedRange.Rows.Count 19 i = 2 20 imgUrlColumIdx = 3 'URL 图片地址列 21 imgColumIdx = 4 '下载图片即将放置列 22 Set Asheet = Me 23 isLoadImage = IsExistPics() 24 If (isLoadImage = False) Then 25 Call ClearPics 26 Do While i <= r 27 txtUrl = Asheet.Cells(i, imgUrlColumIdx).Value 28 If VarType(Asheet.Cells(i, imgUrlColumIdx)) > vbEmpty Then 29 If VarType(Asheet.Cells(i, imgUrlColumIdx)) = vbString Then 30 If VarType(Asheet.Cells(i, imgColumIdx)) = vbEmpty Then DownNetFile txtUrl, "C:\xiaoming-vab-temporary.jpg", i, imgColumIdx 31 End If 32 End If 33 i = i + 1 34 Loop 35 isLoadImage = True 36 Else 37 Dim BoxResponse As Variant 38 BoxResponse = MsgBox("图片已经下载。 " & Chr(13) & "您是想要重新下载所有图片吗？", vbYesNo, "BG报表信息提示") 39 If BoxResponse = vbYes Then 40 Call ClearPics 41 Do While i <= r 42 txtUrl = Asheet.Cells(i, imgUrlColumIdx).Value 43 If VarType(Asheet.Cells(i, imgUrlColumIdx)) > vbEmpty Then 44 If VarType(Asheet.Cells(i, imgUrlColumIdx)) = vbString Then 45 If VarType(Asheet.Cells(i, imgColumIdx)) = vbEmpty Then DownNetFile txtUrl, "C:\xiaoming-vab-temporary.jpg", i, imgColumIdx 46 End If 47 End If 48 i = i + 1 49 Loop 50 isLoadImage = True 51 End If 52 End If 53 End Sub 54 'download the picture from web,and insert to the active sheet 55 Private Sub DownNetFile(ByVal nUrl As String, ByVal nFile As String, rowIdx As Integer, colIdx As Integer) 56 Dim XmlHttp, B() As Byte 57 Set XmlHttp = CreateObject("Microsoft.XMLHTTP") 58 XmlHttp.Open "GET", nUrl, False 59 XmlHttp.Send 60 If XmlHttp.ReadyState = 4 And XmlHttp.Status = 200 Then 61 B() = XmlHttp.ResponseBody 62 Open nFile For Binary As #1 63 Put #1, , B() 64 Close #1 65 End If 66 Set XmlHttp = Nothing 67 68 'Dim img As Image 69 'Set img = New Image 70 'Set img.Picture = LoadPicture(nFile) 71 'Me.Cells(rowIdx, colIdx + 1) = img 72 Dim rng As Variant 73 Dim FilePath As String 74 Dim Asheet As Worksheet 75 Set Asheet = Me 76 With Asheet 77 FilePath = nFile 78 If Dir(FilePath) <> "" Then 79 .Pictures.Insert(FilePath).Select 80 Set rng = .Cells(rowIdx, colIdx) 81 With Selection 82 .Top = rng.Top + 1 83 .Left = rng.Left + 1 84 .Width = rng.Width - 1 85 .Height = rng.Height - 1 86 End With 87 End If 88 End With 89 Kill (FilePath) 90 End Sub 91 'delete all pictures in active sheet, but do not include the buttom 92 Sub ClearPics() 93 Dim Shp As Shape 94 For Each Shp In Me.Shapes 95 If Shp.Type = 13 Then Shp.Delete 96 Next 97 End Sub 98 'is there any picture inserted 99 Function IsExistPics() 100 Dim isExist As Boolean 101 isExist = False 102 Dim Shp As Shape 103 For Each Shp In Me.Shapes 104 If Shp.Type = 13 Then 105 isExist = True 106 Exit For 107 End If 108 Next 109 IsExistPics = isExist 110 End Function
希望，是看不见的空气，却照在心里的光芒
第一次约会，写得low！当作学习笔记吧。希望帮助到能帮助的，也希望抛砖引玉，在评论区的VIP沙发上有大神的高见，一起交流学习。
本文路径：http://www.cnblogs.com/youler/p/9046358.html