Question

我目前正在开展一个项目，需要通过网址填写带有图片的单元格。所有网址都在一列中，我想在相邻的列中加载图片。我不是VBA专家，但我找到了一些有用的代码，但由于某些原因我得到一个错误（通常是5张图片），上面写着：

运行时错误'1004'：无法获取图片类的“插入”属性

同样，我正在使用一个系统，其中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

Answer 1

这是我在一个月前发布的几乎完全相同的解决方案：

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

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

使用VBA将在线图片插入Excel

2 个答案: