使用VBA在Excel中插入在线图片

Question

我目前正在一个项目中工作，需要通过URL填充单元格中的图片。所有的URL都在一列中，我想在相邻的一列中加载这些图像。虽然我不是VBA专家，但我找到了一些代码可以使用，但是出现了一个错误（通常在5张图像后），错误信息如下：

运行时错误 '1004': 无法获取Pictures类的Insert属性

再次强调，我使用的是一个系统，其中URL在一列中，例如：

xxxx.com/xxxx1.jpg

xxxx.com/xxxx2.jpg

xxxx.com/xxxx3.jpg

xxxx.com/xxxx4.jpg

通过搜索，我发现这可能与我的Excel版本有关（使用2010版），尽管我不完全确定。

以下是我正在使用的当前代码：

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

非常感谢您的帮助！

原始代码来源：http://www.mrexcel.com/forum/excel-questions/659968-insert-image-into-cell-url-macro.html

- Richard Oppenheimer

---

对我来说没问题... 当你遇到错误时，filenam的值是多少？ - Siddharth Rout

我最近回答了一个非常类似的问题。让我看看能否找到它。 - David Zemens

尝试：http://stackoverflow.com/questions/15588995/excel-vba-insert-images-from-image-name-in-column/15589423#15589423 - David Zemens

Answer 1

这是我大约一个月前发布的一个几乎相同的解决方案：

Excel VBA 在列中使用图像名称插入图像

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

- David Zemens

---

David，感谢你的帮助！现在一切似乎都正常了。尽管有点尴尬，但看起来缺少的主要组件是处理任何错误的代码段：On Error Resume Next之后，看起来一切都运行顺畅。唯一的障碍是，如果我运行超过200行，Excel会冻结。然而，这只是一个快速解决方法，可能是我的计算机设置问题。 - Richard Oppenheimer

应该避免使用“On Error Resume Next”。更好的做法是捕获错误并编写潜在异常的代码，而不是简单地忽略它们，这就是该语句所做的。 - David Zemens

Answer 2

我知道这个帖子已经有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

- Electric Potato

---

不要删除所有图片。如果要在范围内选择性地删除图片，请执行以下操作：https://www.mrexcel.com/board/threads/delete-pictures-within-a-range-vba.937804/（尝试） - ihightower