excel调用外网图片

liyuli_1

各位大神：
    小弟有在此跪求各位帮忙解决个，EXCEL调用网页图片的方法。
需求如附件，下面图片简单说下：
http://a.vpimg2.com/upload/merch ... 0/00173341-05-1.jpg   调用的外网链接是这样的链接。非图片上的那种，

liyuli_1

真的是着急呢，在线等通过~~~！

liyuli_1

唔唔，高人，救救我吧

liyuli_1

Sub Macro1()
Range("B1").Select
ActiveSheet.Pictures.Insert("http://*********.jpg").Select
End Sub

liyuli_1

liyuli_1 发表于 2016-5-25 15:43
Sub Macro1()
Range("B1").Select
ActiveSheet.Pictures.Insert("http://*********.jpg").Select

这是第一步，还需要加循环继续研究

liyuli_1

Dim pic As String, arr, i, pic1


Sub pi()

Columns("b:b").ColumnWidth = 18

arr = Cells(Rows.Count, 1).End(3).Row

For i = 2 To arr

pic = Sheets(1).Range("A" & i)


Range("B" & i).Select

ActiveSheet.Pictures.Insert(pic).Select

Rows(i).RowHeight = 145

Next i

'MsgBox w1

End Sub

liyuli_1

Dim pic As String, arr, i, pic1


Sub pi()

Columns("a:a").ColumnWidth = 18

arr = Cells(Rows.Count, 2).End(3).Row

For i = 2 To arr

pic = Sheets(1).Range("b" & i)

If pic = "" Then
Cells(i, 1) = ""
Else
Range("a" & i).Select
ActiveSheet.Pictures.Insert(pic).Select
End If


Rows(i).RowHeight = 145

Next i

'MsgBox pic

End Sub

liyuli_1

Dim pic As String, arr, i, pic1


Sub pi()

Columns("a:a").ColumnWidth = 18

arr = Cells(Rows.Count, 2).End(3).Row

For i = 2 To arr

pic = Sheets(1).Range("b" & i)

If CStr(Trim(pic)) = "" Or CStr(Trim(pic)) = "0" Then
Cells(i, 1) = ""
Else
Range("a" & i).Select
ActiveSheet.Pictures.Insert(pic).Select
End If


Rows(i).RowHeight = 145

Next i

'MsgBox pic

End Sub




增加一项规避错误

liyuli_1

Sub insertPic()
    On Error Resume Next
    Dim i As Integer
    Dim FilPath As String
    Dim rng As Range
    Dim s As String
     
        With ActiveSheet
            
            Columns("a:a").ColumnWidth = 12 '调整A列为宽度为12PX
            
            arr = Cells(Rows.Count, 2).End(3).Row '判读有多少行数据
   
               
                For i = 2 To arr '变量 I 从2开始循环到  ARR
                    
                    FIL = ActiveSheet.Range("B" & i) ' FIL 等于   B&数字  即定位单元格
                    
                        If Left(FIL, 4) = "http" Then  '  如果 FIL 前4位=http then  FilPath = ActiveSheet.Range("B" & i) '
                        
                            FilPath = ActiveSheet.Range("B" & i) '  FilPath 等于   B&数字  即定位单元格
                           
                                Else '否则  FilPath = ActiveSheet.Range("U" & i) '
                                
                            FilPath = "" 'FilPath 取 U列单元格链接
                         End If
                        
            Set rng = .Cells(i, 1) '
            
         
            
            With rng
                ML = .Left
                MT = .Top
                MW = .Width
                MH = .Height
                ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select
                Selection.ShapeRange.Fill.UserPicture FilPath
             End With
            
            Rows(i).RowHeight = 145 '将行变成145px

            .Cells(i, 1).Select
               Next
            
        End With

'  MsgBox FIL
End Sub