Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/25.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
使用VBA将联机图片插入Excel_Vba_Excel_Spreadsheet - Fatal编程技术网

使用VBA将联机图片插入Excel

使用VBA将联机图片插入Excel,vba,excel,spreadsheet,Vba,Excel,Spreadsheet,我目前正在做一个项目,需要通过URL用图片填充单元格。所有URL都在一列中,我想在相邻的列中加载图像。我不是VBA专家,但我发现了一些有效的代码,但出于某种原因,我得到了一个错误(通常是5幅图像),上面说: 运行时错误“1004”: 无法获取Pictures类的Insert属性 同样,我使用的是一个URL位于一列的系统,即: xxxx.com/xxxx1.jpg xxxx.com/xxxx2.jpg xxxx.com/xxxx3.jpg xxxx.com/xxxx4.jpg 通过一些搜索,我发现

我目前正在做一个项目,需要通过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
任何帮助都将不胜感激


原始代码源:

这是一个几乎完全相同的解决方案,我大约一个月前发布过:

Sub InsertPic()
Dim pic作为pic的字符串文件路径
将myPicture变暗为图片“嵌入图片”
Dim rng作为我们将迭代的范围
Dim cl作为范围迭代器

Set rng=Range(“B1:B7”)”我知道这个线程已经有5年的历史了,但我只是想说它在一个项目中确实帮助了我。 我正在使用VBA从orders数据库中引入数据。当我从这些结果中点击一个订单时,它会带来关于订单的更多细节,包括一个图像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

为我工作。。。当您遇到错误时,
filenam
的值是多少?我最近回答了一个非常类似的问题。让我看看能不能找到。试试看:大卫,谢谢你的帮助!现在一切似乎都好了。虽然有点尴尬,但看起来缺少的主要组件是检查任何错误的代码位:在错误恢复之后,看起来一切都很顺利。这里唯一的障碍是,如果我运行超过200行,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