Excele dosyadan resim çağırmak

Katılım
19 Ekim 2020
Mesajlar
7
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
17-11-2023
Saygıdeğer Arkadaşlar.

Elimde bir dosyam var. ( Ekte Mevcut ) Sarı alana Personel Kimlik Numaralarını düşey arayla getirdiğimde sarı renk ile boyadığım yere personelin resmi gelsin istiyorum. ( Mümkünse Resim Boyutunu otomatik ayarlarsa çok iyi olur benim için )

Resimleri Bu klasöre koyuyorum. C:Resimler
 

Ekli dosyalar

Katılım
19 Ekim 2020
Mesajlar
7
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
17-11-2023
yokmu yardımcı olacak kimse :-(
 
Katılım
19 Ekim 2020
Mesajlar
7
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
17-11-2023
Saygıdeğer Hocam , Emeğinize sağlık çok güzel olmuş.
Fakat ufak bir problemim var. TC Yazdığım hücreye resim geliyor imza yazan yerin karşılığına nasıl getirebilirim.
 

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Saygıdeğer Hocam , Emeğinize sağlık çok güzel olmuş.
Fakat ufak bir problemim var. TC Yazdığım hücreye resim geliyor imza yazan yerin karşılığına nasıl getirebilirim.
Değerli Arkadaşım Tekrar Merhaba

Aşağıdaki dosyayı deneyiniz.

Hayırlı Çalışmalar Dilerim.
 

Ekli dosyalar

Katılım
19 Ekim 2020
Mesajlar
7
Excel Vers. ve Dili
Excel 2016
Altın Üyelik Bitiş Tarihi
17-11-2023
Oldu :) Çok teşekkür ederim emeğinize sağlık..
 

sosyete33

Altın Üye
Katılım
14 Aralık 2021
Mesajlar
5
Excel Vers. ve Dili
excel vs ders
Altın Üyelik Bitiş Tarihi
06-02-2025
Merhabalar elimdeki dosyaya istinaden , resimlerin sütunlara değilde satırlara gelmesi şeklinde ,A2 ye kodu yazınca A1 de resim , b2 ye kodu yazınca b1 de resim ..... şeklinde

Sub Test()

Dim NoA As Long, i As Long
Dim PicFile As String, PicTop As Integer, PicLeft As Integer, PicW As Integer, PicH As Integer
NoA = Range("B" & Rows.Count).End(xlUp).Row

For i = 2 To NoA
PicFile = "d:\Desktop\pics\" & Range("B" & i).Text & ".jpg"
If Dir(PicFile) = Empty Then
Range("A" & i) = "Resim bulunamadı..!"
GoTo ResumeFor:
End If
PicTop = Range("A" & i).Top
PicLeft = Range("A" & i).Left
PicW = Range("A" & i).Width
PicH = Range("A" & i).Height
Set MyPic = ActiveSheet.Shapes.AddPicture(PicFile, True, True, PicLeft, PicTop, PicW, PicH)
ResumeFor:
Next
End Sub
 
Üst