Soru multipage1 üzerinde image1 üstüne bul tuşuna bağlı resim çağırma

[cems]

Sitede eski örnekler araştırdım anlamak ve çalıştırmak için , hata vermese de bu kod resmi çağırmıyor , hatayı bulamıyorum.
C:\personelfoto klasörü içinde fotoğraflar ve bir de fotoyok resmi var, fotolar .jpg ve adları tc no dur. "fotoyok" resmi aynı resim image1 in arka plan fotosu .

Sorun , textbox31 de yazılan tc kimliğe ait fotolar gelse de , fotosu olmayan kişinin datası gelirken resmi bir önce çağrılan kişinin resminin silinmemesi ile başladı.

Araştırırken ekteki kodu uyarladım ama bu sefer de datalar gelse de image1 deki arka plan resminin de silinmesi ama hiçbirinin resminin gelmemesi ve şahsın resmi yok " mesajının , foto var olduğu halde yukselmesi olarak çıkmaza girdi ve sormaya karar verdim.

Basitçe istediğim işlev : C altındaki personelfoto klasöründe bulunan ve adları tcno olan resimler bul tuşuna bağlı ek işlev olarak , textbox31 deki tcno ile eşleştiğinde resmi image1 nesnesinde görüntülemek , eşleşmediğinde ise fotoyok adlı arkaplandaki resmin görüntüde kalması.

Bunun için alltta verdiğim kodlarda nasıl bir düzeltme gerekir ya da daha basit bir resim çağırma kodu kullanmak doğru olacak ?

Private Sub CommandButton51_Click()

Sheets("personeldata").Select
Set bul = Range("a:a").Find(TextBox30)
    If Not bul Is Nothing Then
        bul.Offset(0, 1).Select
        TextBox30 = bul.Value
        TextBox31 = bul.Offset(0, 1).Value
        TextBox32 = bul.Offset(0, 2).Value
        TextBox33 = bul.Offset(0, 3).Value
        TextBox34 = bul.Offset(0, 4).Value
        TextBox35 = bul.Offset(0, 5).Value
        TextBox36 = bul.Offset(0, 6).Value
        TextBox37 = bul.Offset(0, 7).Value
        TextBox38 = bul.Offset(0, 8).Value
        TextBox39 = bul.Offset(0, 9).Value
        TextBox40 = bul.Offset(0, 10).Value

Dim Hedef, resimadi, Dosya, uzanti

Hedef = ThisWorkbook.Path & "\personelfoto\"

resimadi = TextBox31.Value
uzanti = ".jpg"

Dosya = Hedef & resimadi & uzanti

If CreateObject("Scripting.FileSystemObject").FileExists(personelfoto) = True Then
Image1.Picture = LoadPicture(personelfoto)

Else
Dosya = Hedef & "\fotoyok.jpg"
Userform1.Image1.Picture = LoadPicture(personelfoto)
MsgBox "ŞAHSA AİT RESİM YOK. "
End If

    MsgBox "Aranan veri bulunamadı!", vbCritical

Dim i As Byte
        For i = 31 To 39
Me.Controls("textbox" & i) = ""
Next i
  End If

ThisWorkbook.Save
End Sub

 

[Ömer]

Merhaba,

Kodları denemedim, silinme olayı için resmi almadan önce aşağıdaki satırı ilave ederek dener misiniz.

Image1.Picture = LoadPicture("")

.

 

[Korhan Ayhan]

Ek olarak resmin sağlıklı şekilde görüntülenmesi için Me.Repaint komutunuda eklemenizde fayda var.

 

[cems]

Sayın Korhan Ayhan ,
Bir kaç şekilde ve kodla var olan fotoları userform üzerindeki image1 üzerine getirsem de , kişinin resmi olmadığında ya hata verdi ya da bir önceki resim kaldırılmadığından görünmeye devam etti. Eminim, göremediğim bir şey var ancak denemekten kodlar kafamda balon oldu.
Bütün dosyanın zorlaştırıcı fonksiyonları ( tamekran gibi ) susturulmuş halde zip hali ektedir.
Multipage üstündeki sayfalardan personel kayıt sayfasında bul tuşuna tıkladığınızda denenen kodların hepsini sildim ve tam ne gerektiği hakkında not bıraktım. Zip içindeki klasör C sürücüsüne konmalı ve dosya bu hedefle çalışmalıdır.
İncelerseniz sevinirim

 

[cems]

Sayın @Ömer

Sayın @Korhan Ayhan Sistemde değil, sizin vaktiniz olduğunda gözatma şansınız olur mU ?

 

[byfika]

Merhabalar, Textbox31 e alttaki kodu uygulayıp Fotoğraf yükle (CommandButton59) butonu olmadan TC girdiğinizde personelin resmi gelecek, personel resmi yoksa fotoyok gelecek. Dener misiniz?
Personel re:simlerini PERSONEL adlı klasöre koyarsanız ;
Resim yolu alt satırdaki gibi olacak:
resimYol = ThisWorkbook.Path & "\PERSONEL\"

Eğer örneğinizdeki gibi olursa sadece alttaki koyu pc ismini kendi bilgisayarınızın ismini yazarsanız isteğiniz olacaktır.

Private Sub TextBox31_Change()
resimYol = "C:\Users\PC\Desktop\personelfoto\personelfoto\"
resimler = Dir(resimYol & "*.*")
resim = 0
While resimler <> ""
DoEvents
resimlerAd = Mid(resimler, 1, Len(resimler) - 4)
If resimlerAd = Me.TextBox31.Text Then
Me.Image1.Picture = LoadPicture(resimYol & resimler)
resim = 1
End If
resimler = Dir
Wend
If resim = 0 Then Me.Image1.Picture = LoadPicture(resimYol & "fotoyok.jpg")
Image1.PictureSizeMode = fmPictureSizeModeZoom
End Sub

İyi çalışmalar

 

[cems]

Sayın @byfika ,
Deniyorum , ilginiz için teşekkür ederim .

 

[byfika]

CommandButton54_click deki
Image1.Picture = LoadPicture(ThisWorkbook.Path & "\personelfoto\" & "fotoyok" & ".jpg") kodunu silmelisiniz eğer silinmezse FORMU BOŞALT butonuna tıklarsanız hata verecektir.

 

[cems]

Sayın @byfika

iki kere yazılmış olan [resimYol = "C:\Users\PC\Desktop\personelfoto\personelfoto\" ] satırında ikinciyi sildikten ve PC adını yazınca ve textbox31 içinde tc yazınca hatasız olarak resmi getirdi. Buraya kadar sorun yok.

Ancak hazırlaması bittiğinde bu çalışmayı teslim edeceğim üye kodlara girse de içinden çıkamayabilir zira iş bilgisayarına yükleyerek kullanacak .
Bu açıdan kodlarda onarma ile değil , C sürücüsüne bir PERSONELFOTO klasörü yükleyebilir ve içindeki programdan da masaüstüne sadece kısayol sürükleyebilir ,buna tıklayarak açabilir. Dolayısı ile textbox change pratiği değil bul yönlendirmesi kendisi için daha kullanılır olacaktır.

Bu mesaja klasörün tamamını , SIRA no BUL tuşu çalışır durumda ekliyorum . Bunda kişi detayı ve resim bulamazsa boşaltıp ilk boş sıra numara sına geri dönüyor . Ancak personel sayısı arttıkça sıra no işlevini kaybedecektir , bu durumda tcno ve ad soyad üzerinden arama ,ile data ve resime ulaşması daha kolay olacaktır.

C sürücüsünde PERSONELFOTO klasör konumu ile çalışaBilecek TCNO ve İSİM SOYAD yanındaki BUL tuşlarının ;
hem data hem resim bulması
data bulamadığında veri yok diyerek userformu boşaltması ve ilk boş satır no yu göstermesi ve FOTOYOK resmini açması ,
data bulup resim bulamazsa FOTOYOK resmini açması

için indirdiğiniz ilk kopyayyı çatışmaması için bir foldera atarak ve bu kopyadaki klasör c sürücüsüne yükleyerek BUL kodlarını bu pozisyona göre kontrol edip düzeltirseniz sevinirim.

 

[Ömer]

Merhaba,

Dosyadan anladığım kadarıyla;
Formdaki personel girişi sekmesindeki Listbox3 tıkladığınızda resimler nesneye gelir, resmi bulamadıklarında foto yok gelir.
Detaylı deneme yapmadım.

Private Sub ListBox3_Click()

    Dim yol As String, resim_adi As String, syf As Worksheet, SiraNo As Long

    Set syf = Sheets("Personeldata")
    SiraNo = ListBox3.ListIndex + 2
    yol = ThisWorkbook.Path
    resim_adi = yol & "\" & syf.Cells(SiraNo, "B") & ".jpg"
 
    With Image1     
        .Picture = LoadPicture("")
 
        If Dir(resim_adi) = "" Then
            .Picture = LoadPicture(yol & "\fotoyok.jpg")
            .PictureSizeMode = fmPictureSizeModeStretch
        Else
            .Picture = LoadPicture(resim_adi)
            .PictureSizeMode = fmPictureSizeModeStretch
        End If     
    End With
 
End Sub

 

[cems]

Sayın @Ömer

Teşekür ederim öncelikle
Önerdiğiniz kodları şu şekilde genişletince :

Private Sub ListBox3_Click()
Dim yol As String, resim_adi As String, syf As Worksheet, SiraNo As Long

    Set syf = Sheets("Personeldata")
    SiraNo = ListBox3.ListIndex + 2
    yol = ThisWorkbook.Path
    resim_adi = yol & "\" & syf.Cells(SiraNo, "B") & ".jpg"
  
    With Image1
        .Picture = LoadPicture("")
  
        If Dir(resim_adi) = "" Then
            .Picture = LoadPicture(yol & "\fotoyok.jpg")
            .PictureSizeMode = fmPictureSizeModeStretch
            Exit Sub
        Else
            .Picture = LoadPicture(resim_adi)
            .PictureSizeMode = fmPictureSizeModeStretch
        End If
    End With
    
TextBox30 = ListBox3.List(ListBox3.ListIndex, 0) 'ListBox'a tıkladığımızda değerleri textbox'lara alıyoruz.
TextBox31 = ListBox3.List(ListBox3.ListIndex, 1)
TextBox32 = ListBox3.List(ListBox3.ListIndex, 2)
TextBox33 = ListBox3.List(ListBox3.ListIndex, 3)
TextBox34 = ListBox3.List(ListBox3.ListIndex, 4)
TextBox35 = ListBox3.List(ListBox3.ListIndex, 5)
TextBox36 = ListBox3.List(ListBox3.ListIndex, 6)
TextBox37 = ListBox3.List(ListBox3.ListIndex, 7)
TextBox38 = ListBox3.List(ListBox3.ListIndex, 8)
TextBox39 = ListBox3.List(ListBox3.ListIndex, 9)
    
ThisWorkbook.Save

end sub

image1 'e doğru resim ve resim olmadığında fotoyok resmi ile data , listboxta bir satıra tıklayınca sorunsuz geldi . Listbox hassaslaştırma daha sonra düşündüğüm bir konuydu , bu da sayenizde çözülmüş oldu.

Ancak personel sayısı ve resmi 100 üzerinde olduğunda listboxu gözle tarama zorlaşacaktır. Bu nedenle TCNO ve İSİMSOYAD yanlarındaki BUL tuşlarını hem resim hem datayı doğru bulmak için bunları nasıl çalıştırabilirim ?

 

[Ömer]

personel girişi sekmesindeki "bul" butonu ile mi? Evet ise; hangi textbox ile aranacak?

 

[cems]

personel girişinde tc kimlik textbox31 textboxu yanındaki ve İsim Soyad textbox32 textboxu yanındaki BUL tuşları ile bağımsız olarak aranacak . Sıra no texbox30 yanındaki bul tuşu şu an çalışıyor , küçük bir sorun olarak kişinin verisi var ama resmi yoksa FOTOYOK resmi gelmiyor , ancak şu an böyle de kullanılır durumda . Bu tuşları ikinci kez yüklediğim dosyada görebilirsiniz . İlk yüklemedeki dosyada yoklar

 

[byfika]

Ekteki dosyayı Dener misiniz? Sıra no dan, Tc no dan ve İsimden bulup verileri ve resimleri getirmekte

 

[cems]

Sayın @byfika ,
cc: Sayın @Ömer , Sayın @Korhan Ayhan

Sayın Korhan Ayhan ve Sayın Ömer 'in özelikle listbox kod önerileri ve Sayın byfika'nın textbox31 ve textbox32 yanlarındaki bul tuşları için verdiği önerilerle çalışmanın bu sayfasında istenen fonksiyonlara erişilmiş oldu.
Not : Sayın byfika, tuşların altında resim getirme kodlarını göremeyince ya da anlamayınca şunlarla geliştirdim

Private Sub CommandButton56_Click()
Sheets("personeldata").Select
Dim Bul As Range
Set Bul = Sheets("personeldata").Columns(2).Find(what:=TextBox31)
        TextBox32.Text = Bul.Offset(0, 1).Value
        TextBox30 = Bul.Offset(0, -1).Value
        TextBox33 = Bul.Offset(0, 2).Value
        TextBox34 = Bul.Offset(0, 3).Value
        TextBox35 = Bul.Offset(0, 4).Value
        TextBox36 = Bul.Offset(0, 5).Value
        TextBox37 = Bul.Offset(0, 6).Value
        TextBox38 = Bul.Offset(0, 7).Value
        TextBox39 = Bul.Offset(0, 8).Value
        TextBox40 = Bul.Offset(0, 9).Value
     
Dim Hedef, resimadi, Dosya, uzanti
Hedef = ThisWorkbook.Path & "\"
resimadi = TextBox31.Text
uzanti = ".jpg"
Dosya = Hedef & resimadi & uzanti

If CreateObject("Scripting.FileSystemObject").FileExists(Dosya) = True Then
Userform1.Image1.Picture = LoadPicture(Dosya)

Else
If TextBox32 = "" Then
MsgBox "Aranan veri ya da foto veya ikisi birden bulunamadı!", vbCritical
UserForm_Initialize
End If
  End If
   End Sub

Ayrıca textbox30 değişmiyordu , onu da araya ekledim . Şu an denemelerde bir sorun yok gibi . Sizin eklediğiniz dosyada bunca senedir ilk kez karşılaştığım bir hata mesajı oldu , resmini ekledim ve evet ya da hayır seçeneklerinde userform açılmadı , nedendir anlamadığımdan sizin kodlarınızı bendeki dosyaya ekledim, çalıştı , eklemelerden sonra sorun simdilik yok.

Her 3 candan yardım edene müteşekkirim , iyi ki varsınız

 

[byfika]

Merhabalar Sayın Cems,
İyi ki excel.web.tr var, iyi ki yardımlaşmayı seven dostlar var, bende sizden daha önce yardım almıştım. Sizin butonlardaki resim getirme kodlarını gördüm. Her üç butonda da yazılması gerekli olduğundan, textbox 31 change bölümüne kodları tek olarak yazılması ile fazladan kod yazmaya gerek olmayacağını düşünmüştüm. Sadece Buton51 den sizin resim kodlarını silmeyi unutmuşum. Hangisi daha doğru çalışırsa o kullanılır. Yararlanan diğer arkadaşlarada alternatif olur.
Sayfadaki yardımlaşma için caba gösteren tüm arkadaşlara teşekkürler, iyi ki varsınız...