• DİKKAT

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

veri doğrulama ile resim çağırma

O

onrays

Katılım
12 Aralık 2011
Mesajlar
84
Excel Vers. ve Dili
2007 / Türkçe
Merhaba,

Sitede arama yaptığımda bir çok resim çağırma formatıyla karşılaştım. Yaklaşık olarak hepsini kontrol ettim.Fakat benim istediğim biraz daha farklı ve/veya 1-2 kod eklenmesi gerektiğinden dolayı yapamadım.

Makrolu ve/veya Makrosuz çözümlerini bildirebilir misiniz?

Teşekkür ederim.
 

Ekli dosyalar

Sorun sayfasının kod kısmına ekleyin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    Sheets("Sorun").Shapes("resim").Delete
    isim = Sheets("Sorun").Range(Target.Address)
    Sheets("resimler").Select
    Sheets("resimler").Shapes(isim).Copy
    Sheets("Sorun").Cells(Target.Row, 2).PasteSpecial
    Sheets("Sorun").Select
    Selection.ShapeRange.Name = "resim"
    Sheets("Sorun").Shapes("resim").Width = ActiveCell.Width
    Sheets("Sorun").Shapes("resim").Height = ActiveCell.Height
    Sheets("Sorun").[a1].Select
End Sub
 
Hamitcan ilgin için Teşekkür ederim.

Hangilerinde seçim yapılırsa seçim yapılanların hepsi görünmesi gerekiyor.

Resimler sayfasında aşağıya doğru resim eklediğimde resmi almadı.
 
onrays' Alıntı:
Merhaba,

Sitede arama yaptığımda bir çok resim çağırma formatıyla karşılaştım. Yaklaşık olarak hepsini kontrol ettim.Fakat benim istediğim biraz daha farklı ve/veya 1-2 kod eklenmesi gerektiğinden dolayı yapamadım.

Makrolu ve/veya Makrosuz çözümlerini bildirebilir misiniz?

Teşekkür ederim.
Genişletmek için tıkla ...

.

Dosyanız ekte.

Ad tanımlamalarına bakınız.

.
 

Ekli dosyalar

Not:mal_kabul isimli resmin ismini mal kabul olarak değiştirin yoksa hata verir.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    With Sheets("Sorun")
        Sil
        For Each hcr In [d5:d11]
            isim = Sheets("Sorun").Range(hcr.Address)
            Sheets("resimler").Select
            Sheets("resimler").Shapes(isim).Copy
            .Select
            .Cells(hcr.Row, 2).PasteSpecial
        Next
        Boyut
    End With
    Application.ScreenUpdating = True
    [a1].Select
End Sub
Sub Sil()
    Application.CutCopyMode = False
    For Each shp In ActiveSheet.Shapes
       shp.Delete
    Next
End Sub
Sub Boyut()
    For Each shp In ActiveSheet.Shapes
        shp.Width = 37.68
        shp.Height = 30
    Next
End Sub
 
Öncelikle ilginiz için Teşekkür ederim.

Yurttas Hocam : Sizin çözümünüz istediğime çok yakın tek sorunum veri doğrulamayı sildiğimde yani o satır boş olduğunda resim olmaması yönündedir.

Hamitcan Hocam : Sizin çözümünüzde ise sanırım bir hata var. Birini seçtiğimde hepsi düşüyor. Yanlış düşenler oluyor. Tekrar bakabilirseniz. Sizde göreceksiniz.

Tekrar ilginiz için Teşekkür ederim.
 
Dosya üzerinde dener misiniz ? Ayrıca, kodda ufak bir değişiklik yaptım.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    With Sheets("Sorun")
        Sil
        For Each hcr In [d5:d11]
            isim = Sheets("Sorun").Range(hcr.Address)
            Sheets("resimler").Select
            Sheets("resimler").Shapes(isim).Copy
            .Select
            .Cells(hcr.Row, 2).PasteSpecial
        Next
        Boyut
    End With
    Application.ScreenUpdating = True
    [a1].Select
End Sub
Sub Sil()
ActiveSheet.DrawingObjects.Delete
End Sub
Sub Boyut()
    For Each shp In ActiveSheet.Shapes
        shp.Width = 37.68
        shp.Height = 30
    Next
End Sub
 

Ekli dosyalar

onrays' Alıntı:
Öncelikle ilginiz için Teşekkür ederim.

Yurttas Hocam : Sizin çözümünüz istediğime çok yakın tek sorunum veri doğrulamayı sildiğimde yani o satır boş olduğunda resim olmaması yönündedir.

Hamitcan Hocam : Sizin çözümünüzde ise sanırım bir hata var. Birini seçtiğimde hepsi düşüyor. Yanlış düşenler oluyor. Tekrar bakabilirseniz. Sizde göreceksiniz.

Tekrar ilginiz için Teşekkür ederim.
Genişletmek için tıkla ...

.

Bir de buna bakın.

.
 

Ekli dosyalar

Yurttaş Hocam : Sizin çalışmanız sorunumu ciddi anlamda çözüyor.

Hamitcan Hocam : Sizin çalışmanız seçilen veriyi çağırmada sıkıntı yok fakat veri doğrulamayı sildiğim yani boş olduğu zaman "affetmez" resmini getiriyor.

İlgi ve alakanız için Teşekkür ederim.

Hamitcan hocam eğer vakit bulurda makro ile çözüm yolunu da yapabilirseniz tarafımca alternatif olacaktır.

Teşekkür ederim.
 
Kodu, aşağıdaki şekilde değiştirin.
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Application.ScreenUpdating = False
    With Sheets("Sorun")
        Sil
        For Each hcr In [d5:d11]
        If hcr = "" Then GoTo 10
            isim = Sheets("Sorun").Range(hcr.Address)
            Sheets("resimler").Select
            Sheets("resimler").Shapes(isim).Copy
            .Select
            .Cells(hcr.Row, 2).PasteSpecial
10
        Next
        Boyut
    End With
    Application.ScreenUpdating = True
    [a1].Select
End Sub
 
arkadaşlar günaydın. buna benzer bir çalışma yapmam gerekiyor.yukarıdaki örneği ve diğer resim çağırma örneklerini inceledim. veri doğrulama ve liste yapmayı biliyorum ama resmi nasıl çağırıldığını anlamadım. kısaca anlatabilecek olan varmı.
 
Yapmak istediğim şey fabrikadaki tüm personelin ismine göre veya koduna göre resmi getirmesi. yaklaşık 250 personel var.aslında veri doğrulamaya gerek yok. başka bir şekilde de resmin gelmesi benim için yeterli.yardımlarınız için şimdiden teşekkürler...
 
işyerindeki kısıtlama yüzünden dosya eklenmedi sanırım. üstad verdiğiniz örnekleri de inceliyorum.
 

Ekli dosyalar

Yurttaş hocam merhaba.verdiğiniz linki inceledim. o örneklerde tek bir hücreye resim getirmeyi anlatıyor. benim yapmak istediğim güncel bir resimli personel listesi oluşturabilmek. fabrikada yaklaşık 400 kişi çalışıyor bunlardan ayrılan ve yeni girenler oluyor. güncel bir dosya oluşturmak için toplu bir resim çağırmaya ihtiyacım var. sizin 5. örnekte yaptığınız çalışma bana uygun. ben de buna uyarlayarak çalışmamı yaptım. ancak sadece 7 kişinin resmini çağırıyor. yazılan bir makro yok formül yok bunu nasıl yaptığını da çözemedim. benim öğrenmek istediğim bu işin mantığı. hocam yardımlarınız için teşekkür ederim.
 
spacebar' Alıntı:
Yurttaş hocam merhaba.verdiğiniz linki inceledim. o örneklerde tek bir hücreye resim getirmeyi anlatıyor. benim yapmak istediğim güncel bir resimli personel listesi oluşturabilmek. fabrikada yaklaşık 400 kişi çalışıyor bunlardan ayrılan ve yeni girenler oluyor. güncel bir dosya oluşturmak için toplu bir resim çağırmaya ihtiyacım var. sizin 5. örnekte yaptığınız çalışma bana uygun. ben de buna uyarlayarak çalışmamı yaptım. ancak sadece 7 kişinin resmini çağırıyor. yazılan bir makro yok formül yok bunu nasıl yaptığını da çözemedim. benim öğrenmek istediğim bu işin mantığı. hocam yardımlarınız için teşekkür ederim.
Genişletmek için tıkla ...

.

Dosyanız ekte.

Tanımlanmış alanlara bakın. Bunu her resim için yapacaksınız.

.
 

Ekli dosyalar

yurttaş hocam merhaba. gönderdiğinizden beri dosyayı inceliyorum. nasıl yapıldığını bulmaya çalıştım. resimin üzerine ad tanımlama yapılmış. bunu yapmayı öğrendim. ama 8.satıra resmi getiremiyorum. ne yapmam gerekiyor.
 
Arkadaşım birincisi o kişiye ait resim sayfasına resim eklemen gerekiyor, ikincisi formuller>>ad tanımlamasında ki yapılanları incelersen eklediğin resimlere ait ad tanımlaması yapman gerekiyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst