Merhaba, geçenlerde elimize bir excel geçti.

İçerisinde malzeme numaraları vardı ve resimlerine ihtiyacımız oldu.

Resimlerin hepsi de belirli bir web adresinde ürün numaraları şeklinde tutuluyordu.

Yani formülize edilebilecek şekilde.

Ben de biraz araştırarak şöyle bir makroyla işimi çözdüm.

Bir kolona resmin URL’sini, diğer kolona da resmin kendisini koyuyorum.

Resmin ilgili adreste var olup olmadığını da kontrol ediyorum.

Sub InsertImage()

Dim lastRow As Integer
Dim i As Integer
Dim itemNo As String
Dim resimAdres As String
Dim url_column As Range
Dim image_column As Range

Set url_column = ActiveSheet.UsedRange.Columns("K")
Set image_column = ActiveSheet.UsedRange.Columns("N")

lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To lastRow
    itemNo = Trim(CStr(ActiveSheet.Range("B" & i)))
    resimAdres = "https://www.firmaismi.com/urunresimleri/" & itemNo & ".jpg"
    If (URLExists(resimAdres)) Then
        ActiveSheet.Hyperlinks.Add _
            Anchor:=url_column.Cells(i), _
                Address:=resimAdres, _
                    SubAddress:="", _
                        ScreenTip:="Critical", _
                            TextToDisplay:="View Image"

        With image_column.Worksheet.Pictures.Insert(resimAdres)
          .Left = image_column.Cells(i).Left
          .Top = image_column.Cells(i).Top
          .ShapeRange.LockAspectRatio = msoTrue
          .ShapeRange.Width = 400
          .ShapeRange.Height = 110
          image_column.Cells(i).EntireRow.RowHeight = .Height
        End With
    End If
    DoEvents
Next
MsgBox "Finito!"


End Sub

Function URLExists(url As String) As Boolean
    Dim Request As Object
    Dim ff As Integer
    Dim rc As Variant

    On Error GoTo EndNow
    Set Request = CreateObject("WinHttp.WinHttpRequest.5.1")

    With Request
      .Open "GET", url, False
      .Send
      rc = .StatusText
    End With
    Set Request = Nothing
    If rc = "OK" Then URLExists = True

    Exit Function
EndNow:
End Function

Resmi ana kaynağından getirerek excelde göstermek de mümkün ama benim ihtiyacım o değildi.

Belki başkasına yarar diyerek onu da buraya koyuyorum.

Sub AddPicture()

Dim lastRow As Integer
Dim i As Integer
Dim itemNo As String
Dim resimAdres As String
Dim url_column As Range
Dim image_column As Range

Set url_column = ActiveSheet.UsedRange.Columns("N")
Set image_column = ActiveSheet.UsedRange.Columns("J")

lastRow = ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row
For i = 3 To lastRow
    itemNo = Trim(CStr(ActiveSheet.Range("D" & i)))
    resimAdres = "https://www.firmaismi.com/urunresimleri/" & itemNo & ".jpg"
    If (URLExists(resimAdres)) Then
        ActiveSheet.Hyperlinks.Add _
            Anchor:=url_column.Cells(i), _
                Address:=resimAdres, _
                    SubAddress:="", _
                        ScreenTip:="Critical", _
                            TextToDisplay:="View Image"

            Set pic = ActiveSheet.Shapes.AddPicture(resimAdres, _
            linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
            With pic
               .LockAspectRatio = msoTrue
               .Left = image_column.Cells(i).Left
               .Top = image_column.Cells(i).Top
               .Width = 400
               .Height = 110
               image_column.Cells(i).EntireRow.RowHeight = .Height
            End With
    End If
    DoEvents
Next
MsgBox "Finito!"

End Sub

Selamlar.