Siteden Resim Çağırma

[openstar]

merhabalar
H2 hücresindeki bir url'nin sonuna D2 hücresindeki değeri ekleyip oluşan yeni url'deki resmi F2 hücresine nasıl eklerin.

yani D2 de L9J8-8868-12 yazmakta mesela;
linkimiz https://api.qrserver.com/v1/create-qr-code/?size=150x150&data= şeklinde
D2 deki degeri ekleyip linki şu şekle çeviriyoruz.

https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=L9J8-8868-12

ve son olarak bu urldeki resmi F2 hücresine ekliyoruz.

Bunu nasıl yaparım, yani özellikle url'deki resmi çekmeyi.
teşekkürler..

 

[PLİNT]

Merhaba
Ek dosyadaki gibi olabilir
https://www.dosyaupload.com/kb34

Private Sub CommandButton1_Click()
Dim adr As String
Dim XMLhttp
        Set XMLhttp = CreateObject("MSXML2.XMLHTTP")
adr = Range("H2").Text & Range("D2").Text
         XMLhttp.Open "GET", adr, False
         XMLhttp.send
With Range("F2")
          ActiveSheet.Shapes.AddPicture adr, msoFalse, msoTrue, .Left, .Top, .Width, .Height
           End With
End Sub

 

[openstar]

Çok teşekkür ederim.
Gayet güzel çaşılıyor. peki buna bir ekleme yapmak istesem. mesela h2 ve d2 sütünlar h2000 ve d2000e kadar devam etse nereyi değiştirmeliyiz

 

[PLİNT]

Çok teşekkür ederim.
Gayet güzel çaşılıyor. peki buna bir ekleme yapmak istesem. mesela h2 ve d2 sütünlar h2000 ve d2000e kadar devam etse nereyi değiştirmeliyiz

Aşağıdaki gibi olabilir

Private Sub CommandButton1_Click()
Dim adr As String, a as long
On Error Resume Next
For a = 2 To 2000
If Range("H" & a) <> "" And Range("D" & a) <> "" Then
adr = Range("H" & a).Text & Range("D" & a).Text
With Range("F" & a)
          ActiveSheet.Shapes.AddPicture adr, msoFalse, msoTrue, .Left, .Top, .Width, .Height
           End With
           End If
           Next
End Sub