Web resim linki en boy piksel değerlerini bulmak?

[ogameci]

Merhaba. Link fotoğrafının eni ve boyunu bulabilir miyiz?
A2 Web resim linki
B2 with pixel değeri
C3 hight pixel değeri

 

[Haluk]

Bahsettiğiniz söz konusu resim https://www.excel.web.tr/ adresindeki URL'in kaynak kodlarında 1. sıradaki resim olduğu için, kodda bu URL'in kendisini kullanırsak;

Sub Test()
    'Haluk - 07/06/2019
    'E-Posta: sa4truss@gmail.com
    Dim IE As Object, URL As String
    Range("A1:C1") = ""
 
    URL = "https://www.excel.web.tr/"

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate URL
 
    Do While IE.busy
        DoEvents
    Loop
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
 
    Set Images = IE.Document.getElementsByTagName("img")
 
    Range("A1") = Images(0).src
    Range("B1") = Images(0).Width
    Range("C1") = Images(0).Height
 
    Set IE = Nothing
End Sub

Veya, verdiğiniz örneğe göre sayfada A2 hücresinde resmin kendisine ait URL varsa, en-boy değerlerini B2 ve C2 hücrelerine almak için;

Sub Test2()
    'Haluk - 07/06/2019
    'E-Posta: sa4truss@gmail.com
    Dim IE As Object, URL As String
    Range("B2:C2") = ""
  
    URL = Range("A2").Text ' >>> A2 hucresindeki metin: https://www.excel.web.tr/styles/default/xenforo/xenforo-logo.png

    Set IE = CreateObject("InternetExplorer.Application")
    IE.Navigate URL
  
    Do While IE.busy
        DoEvents
    Loop
    Do Until IE.ReadyState = 4
        DoEvents
    Loop
  
    Set Images = IE.Document.getElementsByTagName("img")
  
    Range("B2") = Images(0).Width
    Range("C2") = Images(0).Height
  
    Set IE = Nothing
End Sub

Son olarak; eğer A2 hücresinin altındaki diğer hücrelerde başka resimlere ait URL'ler varsa, For-Next döngüsü kullanarak hepsinin Width-Height değerlerini B ve C sütunlarında hücrelere yazdırmak için:

Sub Test3()
    'Haluk - 07/06/2019
    'E-Posta: sa4truss@gmail.com
    Dim IE As Object, URL As String
    Range("B2:C" & Range("A" & Rows.Count).End(xlUp).Row) = ""
    Set IE = CreateObject("InternetExplorer.Application")

    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        URL = Range("A" & i).Text
   
        IE.Navigate URL
       
        Do While IE.busy
            DoEvents
        Loop
        Do Until IE.ReadyState = 4
            DoEvents
        Loop
       
        Range("B" & i) = IE.Document.getElementsByTagName("img").Item(0).Width
        Range("C" & i) = IE.Document.getElementsByTagName("img").Item(0).Height
    Next
    Set IE = Nothing
End Sub

.

 

[ogameci]

Çok teşekkür ederim.
Test2 gayet işim gördü.
Resim klasörünü https://www.excel.web.tr/threads/resim-indirme.110424/ buradaki gibi masaüstüne atıp arada oluşan debug hatasını gidermeye çalıştım.