• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Excelde vba ile hucrede yazan degere gore resim tasima

Katılım
26 Mayıs 2021
Mesajlar
36
Excel Vers. ve Dili
Microsoft Excel 2016 versiyon, Türkçe
Merhaba arkadaşlar,
Excelde a sütununda .jpg formatinda resim adları yer almakta. Örneğin A1 hucresindeki resim adi "acsgd_3.jpg" ise klasorden "acsgd_3.jpg" bu isimde olan resmi B1 sutununa getirsin istiyorum.
Resimler ile excel aynı klasörde
Yardımlarınızı bekliyorum
Şimdiden teşekkürler 🤗
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,606
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Resimler B hücresinin genişliği ve yüksekliğine göre resimler boyutlandırılır. Deneyiniz.

Kod:
Sub ResGetir()

    Dim p As Object, t As Double, l As Double, w As Double, h As Double, i As Double
    Dim Yol As String
    Dim ResimDosya As String
   
    ActiveSheet.Pictures.Delete
    Application.ScreenUpdating = False
   
    Yol = ThisWorkbook.Path & Application.PathSeparator
   
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        ResimDosya = Yol & Cells(i, "A")
        If Dir(ResimDosya) = "" Then Exit For
   
        Set p = ActiveSheet.Pictures.Insert(ResimDosya)
       
        With Cells(i, "B")
            t = .Top
            l = .Left
            w = .Offset(0, .Columns.Count).Left - .Left
            h = .Offset(.Rows.Count, 0).Top - .Top
        End With
       
        With p
            .Top = t
            .Left = l
            .Width = w
            .Height = h
        End With
       
        With Cells(i, "B")
            p.Left = .Left + ((.Width - p.Width) / 2)
            p.Top = .Top + ((.Height - p.Height) / 2)
        End With
       
        Set p = Nothing
       
    Next i
   
    Application.ScreenUpdating = True
   
End Sub
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,606
Excel Vers. ve Dili
Ofis 365 Türkçe
Arkadaşımız resimlerin tedarikiyle uğraşıyor sanırım :)
 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,398
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Mazot fiyatları arttı, tedarik zincirinde sıkıntı var .... az sabırlı ol Necdet Bey. Resimler gelince kodu deneyip haber verecektir :)

.
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,420
Excel Vers. ve Dili
excel 2010
Merhaba

Kodlar boşa gitmesin diye ben kullandım, benim işime yarar. :)
 
Üst