使用 VBA 将在线图片插入 Excel
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/16113876/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Inserting an Online Picture to Excel with VBA
提问by Richard Oppenheimer
I'm currently working on a project and need to fill in cells with pictures via URLs. All URLs are in one column, and I'd like to load the images in an adjacent column. I'm no VBA expert, but I found some code that worked, but for some reason I get an error (usually 5 images in) that says:
我目前正在做一个项目，需要通过 URL 用图片填充单元格。所有 URL 都在一列中，我想加载相邻列中的图像。我不是 VBA 专家，但我发现了一些有效的代码，但由于某种原因，我收到一个错误（通常是 5 个图像），内容为：
Run-time error '1004': Unable to get the Insert property of the Pictures Class
运行时错误“1004”：无法获取图片类的插入属性
Again, I'm using a system where URLs are in one column i.e.:
同样，我使用的系统是 URL 在一列中，即：
xxxx.com/xxxx1.jpg
xxxx.com/xxxx1.jpg
xxxx.com/xxxx2.jpg
xxxx.com/xxxx2.jpg
xxxx.com/xxxx3.jpg
xxxx.com/xxxx3.jpg
xxxx.com/xxxx4.jpg
xxxx.com/xxxx4.jpg
Through some searching, I found that it could be linked to my Excel version (using 2010), though I'm not completely sure.
通过一些搜索，我发现它可以链接到我的 Excel 版本（使用 2010），尽管我不完全确定。
Here's the current code I'm using:
这是我正在使用的当前代码：
Sub URLPictureInsert()
Dim cell, shp As Shape, target As Range
Set Rng = ActiveSheet.Range("a5:a50") ' range with URLs
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set shp = Selection.ShapeRange.Item(1)
With shp
.LockAspectRatio = msoTrue
.Width = 100
.Height = 100
.Cut
End With
Cells(cell.Row, cell.Column + 1).PasteSpecial
Next
End Sub
Any help would be much appreciated!
任何帮助将非常感激！
Original code source: http://www.mrexcel.com/forum/excel-questions/659968-insert-image-into-cell-url-macro.html
原始代码来源：http: //www.mrexcel.com/forum/excel-questions/659968-insert-image-into-cell-url-macro.html
回答by David Zemens
This is an almost identical solution that I posted about a month ago:
这是我大约一个月前发布的几乎相同的解决方案：
Excel VBA Insert Images From Image Name in Column
Sub InsertPic()
Dim pic As String 'file path of pic
Dim myPicture As Picture 'embedded pic
Dim rng As Range 'range over which we will iterate
Dim cl As Range 'iterator
Set rng = Range("B1:B7") '<~~ Modify this range as needed. Assumes image link URL in column A.
For Each cl In rng
pic = cl.Offset(0, -1)
Set myPicture = ActiveSheet.Pictures.Insert(pic)
'
'you can play with this to manipulate the size & position of the picture.
' currently this shrinks the picture to fit inside the cell.
With myPicture
.ShapeRange.LockAspectRatio = msoFalse
.Width = cl.Width
.Height = cl.Height
.Top = Rows(cl.Row).Top
.Left = Columns(cl.Column).Left
End With
'
Next
End Sub
回答by Electric Potato
I know this thread is 5 years old but just wanted to say it really helped me with a project. I'm using VBA to bring in data from an orders database. When I click on an order from those results it brings in more details about the orders including an image URL. The problem I had was that the code above was designed to add the image in place of the URL. I wanted to replace the image from a previous query with the image from the new query. After some tweaks I got it working but it was just laying a new image on top of the old image. In time my Excel file could get really big so here's my solution. The only problem I have right now is that it deletes my company's logo that I put on the sheet. There may be a way to be more selective, or I could just change the procedure to insert the logo from another sheet in the workbook every time it deletes pictures but that seems a bit cheesy.
我知道这个线程已经有 5 年历史了，但只是想说它确实帮助了我完成一个项目。我正在使用 VBA 从订单数据库中引入数据。当我从这些结果中单击订单时，它会显示有关订单的更多详细信息，包括图像 URL。我遇到的问题是上面的代码旨在添加图像代替 URL。我想用新查询中的图像替换先前查询中的图像。经过一些调整后，我让它工作了，但它只是在旧图像上放置了一个新图像。随着时间的推移，我的 Excel 文件可能会变得非常大，所以这是我的解决方案。我现在唯一的问题是它删除了我放在工作表上的公司徽标。可能有一种方法可以更有选择性，
Sub InsertPic()
Dim productImageUrl As String
Dim productImage As Picture 'Declare image picture object
Dim productImageUrlRng As Range 'Declare range object to contain image URL
Dim productImageRng As Range 'Location image will be placed
'Delete any existing pictures:
Set productImageRng = ActiveSheet.Range("J1:J15") 'Where I want to put the image
Set productImageUrlRng = Range("BA2") 'Cell containing image URL
productImageUrl = productImageUrlRng
productImageRng.Select
'productImageRng.Delete --Does not delete pictures in range
ActiveSheet.Pictures.Delete 'Delete existing images
Set productImage = ActiveSheet.Pictures.Insert(productImageUrl)
With productImage
.ShapeRange.LockAspectRatio = msoTrue
'.Width = productImageRng.Width
.Height = productImageRng.Height
' .Top = Rows(cl.Row).Top
' .Left = Columns(cl.Column).Left
End With
End Sub
