Tc kimlik numarası ile resim çekme

[simo41]

Arkadaşlar merhabalar,

Tc kimlik numarasını b2 hücresine yazdığımda d hücresine resimleri ayarlanabilir boyutta çektirmek istiyorum. birkaç deneme yaptım fakat başarılı olamadım. bu konuda bana yardımcı olabilir misiniz ?

 

[Merhum İdris SERDAR]

.

Buradaki örnekleri inceleyin.

Resim – Excel Gurusu

.

 

[simo41]

teşekkür ederim

 

[simo41]

inceledim fakat aradığımı buşamadım

 

[Merhum İdris SERDAR]

.

Aradığınız bulamadınız mı? El insaf diyeceğim. Peki, siz tek satırlık bir soru ile nasıl bir çözüm bekliyorsunuz?

.

 

[metin_0606]

Arkadaşlar merhabalar,

Tc kimlik numarasını b2 hücresine yazdığımda d hücresine resimleri ayarlanabilir boyutta çektirmek istiyorum. birkaç deneme yaptım fakat başarılı olamadım. bu konuda bana yardımcı olabilir misiniz ?

deneyiniz Klasör ismi ve yolunu siz kendinize göre uyarlarsınız

Sub resim_71()
Son = 3
ReDim uzanti(Son)
'uzanti(1) = ".bmp"
uzanti(2) = ".jpg"
'uzanti(3) = ".gif"

With Application
    .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationAutomatic
End With

Klasor = "C:\FOTO\"

Set fso = CreateObject("Scripting.FileSystemObject")
For i = 2 To Cells(Rows.Count, "B").End(3).Row
isim = Cells(i, 2).Value
deg = 0
For j = 1 To Son
If fso.FileExists(Klasor & isim & uzanti(j)) = True Then
Set pc = ActiveSheet.Pictures.Insert(Klasor & isim & uzanti(j)) '<-- dikkat
With pc '<---
    .Top = Cells(i, 4).Top + 2
    .Left = Cells(i, 4).Left + 2
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Height = Cells(i, 4).Height - 4
    .ShapeRange.Width = Cells(i, 4).Width - 4
End With
deg = 1

Exit For
End If
Next
Next
End Sub

 

[simo41]

Teşekkür ederim metin bey işimi fazlasıyla gördü

 

[TURKOLOG]

Sayın @simo41 çalışan örnek dosyanızı paylaşırsanız benim için de fıkır olur . Paylaşırsanız çok teşekkür ederim.