如何使图片链接，批量变成插入图片？

893714217

lylnevermore 发表于 2017-6-9 14:53
你好 有个问题想请教下 为什么我复制你的批量插入图片的代码后显示： 方法‘Userpicture’作用于对象‘Fi ...

这个问题你解决了吗？求教

hoople

很不错 试试

杏山虫虫

已经收藏，十分受用

Only丶冰儿

正好需要这样一段代码，非常感谢大神

TIANSEN

Sub InsertImageFromURL()  
  
    ' 定义变量  
    Dim targetCell As Range  
    Dim imgPath As String  
    Dim img As Picture  
    Dim imgURL As String  
    Dim xmlHttp As Object  
    Dim adodbStream As Object  
  
    ' 图片的URL  
    imgURL = "http://luotuosfoss.oss-cn-shenzhen.aliyuncs.com/sfpublicfiles/client980/PRODUCT/DEV_IMG/980--2438732A2991708398157_38662438732%E5%8D%83%E7%A6%A7%E7%BA%A2.jpg"  
      
    ' 设置目标单元格为G2  
    Set targetCell = ThisWorkbook.Sheets("Sheet1").Range("G2") ' 假设你的工作表名为"Sheet1"  
      
    ' 初始化XMLHTTP和ADODB.Stream对象以下载图片  
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")  
    Set adodbStream = CreateObject("ADODB.Stream")  
      
    ' 发送HTTP GET请求到图片URL  
    xmlHttp.Open "GET", imgURL, False  
    xmlHttp.Send  
      
    ' 如果请求成功，保存图片到临时位置（这里我们直接插入到Excel，不保存到文件）  
    If xmlHttp.Status = 200 Then  
        ' 清除Stream中的任何现有数据  
        adodbStream.Open  
        adodbStream.Type = 1 ' 二进制数据  
         
        ' 将HTTP响应的二进制数据写入Stream  
        adodbStream.write(xmlHttp.responseBody)  
         
        ' 将Stream中的数据保存到Excel工作表中（不保存到文件）  
        ' 注意：Excel的Pictures.Insert方法不直接接受来自Stream的数据，所以我们需要先保存到文件，但这里为了简化，我们直接插入内存中的图片  
        ' 创建一个Picture对象并插入到目标单元格  
        Set img = targetCell.Parent.Pictures.Insert(imgURL) ' 注意：这里实际上不能直接使用URL，但因为我们已经有数据在内存中，我们可以使用其他方法（如Clipboard）  
         
        ' 由于Excel的Pictures.Insert方法不支持直接从内存数据插入，以下是一个简化的插入方法（实际上并未使用内存数据）  
        ' 这里我们只是设置了图片的位置和大小，假设图片已经通过其他方式（如剪贴板）插入  
        With img  
            .ShapeRange.LockAspectRatio = msoFalse  
            .Width = 100 ' 设置图片宽度（可以根据需要调整）  
            .Height = 100 ' 设置图片高度（可以根据需要调整）  
            .Placement = 1 ' 设置为移动但不随单元格大小变化  
            .PrintObject = True  
            .Top = targetCell.Top  
            .Left = targetCell.Left  
            ' 注意：以上代码假设图片已经存在，并且只是调整其位置和大小  
        End With  
         
        ' 清理  
        adodbStream.Close  
        Set adodbStream = Nothing  
    Else  
        MsgBox "Error downloading image: " & xmlHttp.StatusText  
    End If  
      
    ' 清理  
    Set xmlHttp = Nothing  
      
End Sub