小明 和 VBA 的第一次约会

唠嗑老掉牙的一小段

　　我第一次对 EXcel 有感觉，应该是早些年在富士康实践的时候。那时候是在 FQC 岗位做事，有次在过年值夜班比较闲的时候，用了 Excel 做了个工资的计算，其中是利用了 Excel 一些简单的公式来计算的。那时候还很年轻，这个小小的作品也感到小小的喜悦，因为做出来，好多同事也用上了。（那时候工作的电脑只能查看内部网的“新闻”，手机也只能一些干部携带到工作区，数据的拷贝还是用的软盘，没错，就是存储容量1到2 m 容量的软盘）

　　这应该是我第一次间接地爱恋了 VBA（Visual Basic for Applications） 吧。

　　最近我们做了个导出数据表报，其中报表中有图片。考虑到直接在服务器上下载图片并把图片塞到报表中，然后生成文件返回，这样对服务器的内存资源有很大的消耗，我们考虑在客户端实现图片的下载并放置到报表中。

于是我开始看了Excel 的 VBA （Visual Basic for Applications）。这应该就是我和 VBA  阔别多年的第一次约会了。

　　查阅了两天的资料，我简单的实现了根据 Excel 表中的某列值（图片链接）下载图片放置到对应行的某列中。

实现思路是：1、遍历 Excel 表中的图片链接列，拿到图片链接；

2、下载图片，把图片文件临时保存到本地磁盘中；

　　　　　　3、将图片插入到 Excel 的图层中，调整图片的位置以及大小

原始报表

在客户端下载图片

思路简单，代码实现也简单（原始初级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沙发上有大神的高见，一起交流学习。

原文地址：https://www.cnblogs.com/youler/p/9046358.html