• DİKKAT

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

userform üzerine gelen resimler

H

Hacı Bayram ÖZKAN

Katılım
24 Şubat 2009
Mesajlar
1,077
Excel Vers. ve Dili
2016
Merhaba arkadaşlar;
Ekli dosyamda Userform1 üzerinde bulunan TextBook1'de yazılı bulunan TC numarasına göre resimler geliyor, isteğim şu Userform1 üzerinde bulunan Commondbuttan bütona basınca eğer şahsın resmi yok ise; Userform2'nin açılmadan "ŞAHSA AİT RESİM YOK" uyarısı gelsin, resimlerin görüntüsü ok tuşuna basarak bittiğinde "BU ŞAHSA AİT BAŞKA RESİM YOK" uyarısını almak istiyorum. Teşekkürler. Herkese kolay gelsin
 
Son düzenleme:
Böyle deneyin.
Kod: 
Private Sub CommandButton1_Click()
    Hedef = ThisWorkbook.Path & "\Resimler\"
    resimadi = TextBox1.Text
    If Len(Dir(Hedef & resimadi)) = 0 Then MsgBox "ŞAHSA AİT RESİM YOK": Exit Sub
    UserForm2.Show
End Sub
 
Hamitbey; tamam oldu ancak, olan resmi göstermiyor, yani şahsa ait resim varsa Userform üzerinde gösterecek, eğer TC nolu şahsa ait resim yok ise göstermeyecek, üstadım birde ekli dosyamda var bir şahsa ait mesela 3 veya daha fazla resim oluyor, bunları aynı TC'nin -1-2-3 diye yaptım bunlarıda gösterecek. teşekkürler.
 
Böyle deneyin.
Kod: 
Private Sub CommandButton1_Click()
    Hedef = ThisWorkbook.Path & "\Resimler\"
    resimadi = TextBox1.Text
    If Len(Dir(Hedef & resimadi & ".jpg")) = 0 Then MsgBox "ŞAHSA AİT RESİM YOK": Exit Sub
    UserForm2.Image1.Picture = LoadPicture(Hedef & resimadi & ".jpg")
    UserForm2.Show
End Sub
 
Abi teşekkürler çok güzel oldu, ikinci sorum eksik kalmış eğer zamanın varsa bunada bakarmısın, Userform2 üzerinde bulunan ok tuşu ile ileri gidince resim kalmayınca "ŞAHSA AİT BAŞKA RESİM YOK" mesajının gelmesini istiyorum, dua ile kal. Saygılarımla.
 
Böyle deneyin.
Fonksiyonu bir Module içine ekleyin.
Kod: 
Function DosyaSayisi(Yol As String)
  Set objFSO = CreateObject("Scripting.FileSystemObject").GetFolder(Yol)
  DosyaSayisi = objFSO.Files.Count
End Function

Kod: 
Private Sub SpinButton1_Change()
    Hedef = ThisWorkbook.Path & "\Resimler\"
    If SpinButton1.Value > DosyaSayisi(Hedef) Then
        MsgBox "ŞAHSA AİT BAŞKA RESİM YOK"
        UserForm2.Image1.Picture = LoadPicture("")
        Exit Sub
    End If
    resimadi = deg3(Val(SpinButton1.Value))
    resimyükle = Hedef & resimadi ' & "." & resimuzantısı(Val(i))
    UserForm1.Image1.ControlTipText = resimyükle
    UserForm1.Image1.Visible = False
    On Error GoTo atla3
    UserForm2.Image1.Visible = True
    UserForm2.Image1.Picture = LoadPicture(resimyükle)
    Exit Sub
atla3:
    UserForm2.Image1.Visible = False
End Sub
 
tarzanhaci' Alıntı:
Sayın Hamitcan; emeğinize sağlık dua ile kalın, yardımlarınızdan dolayı minnettarım. Saygıyla....
Genişletmek için tıkla ...

Merhaba arkadaşlar; Hamitcan beyin hazırlamış olduğu 7 nolu mesajdaki kodları ekli dosyamda sayın Korhan Ayhan'nın hazırlamış olduğu dosyaya uygulayamadım, buna bir bakarmısınız. Teşekkürler
 
Son düzenleme:
Sayın Hamitcan bey; sizin yazdığınız 7 nolu mesajdaki kodları Korhan Ayhan üstadın, hazırladığı dosyasına uyguladım çalışmadı zamanınız varsa buna bakar mısınız? Teşekkürler.
 
Son düzenleme:
Merhaba arkadaşlar;
Private Sub CommandButton12_Click()
Hedef = ThisWorkbook.Path & "\Resimler\"
resimadi = TextBox4.Text
If Len(Dir(Hedef & resimadi & ".jpg")) = 0 Then MsgBox "ŞAHSA AİT RESİM YOK": Exit Sub
UserForm2.Image1.Picture = LoadPicture(Hedef & resimadi & ".jpg")
UserForm2.Show
End Sub
Bu kodu Deneme dosyamda Bulununan resimleri göster bütonunda çalıştıramadım buna bir bakarmısınız. teşekkürler.
 
Aşağıdaki gibi deneyin.

Kod: 
Private Sub CommandButton12_Click()
    [COLOR=red]Dim Hedef, resimadi[/COLOR]
    Hedef = ThisWorkbook.Path & "\Resimler\"
    resimadi = TextBox4.Text
    If Len(Dir(Hedef & resimadi & ".jpg")) = 0 Then MsgBox "ŞAHSA AİT RESİM YOK": Exit Sub
    UserForm2.Image1.Picture = LoadPicture(Hedef & resimadi & ".jpg")
    UserForm2.Show
End Sub
 
Merhaba arkadaşlar Hamitcan'ın yazmış olduğu kodları ekli dosyama uyguladım. Çalıştıramadım. Bu kodu bir modüle ekledim.
Kod: 
Function DosyaSayisi(Yol As String)
  Set objFSO = CreateObject("Scripting.FileSystemObject").GetFolder(Yol)
  DosyaSayisi = objFSO.Files.Count
End Function

Daha Sonra Userform2 üzerine aşağıdaki kodu yazdım;

Kod: 
Dim deg3(100)
Private Sub SpinButton1_Change()
    hedef = ThisWorkbook.Path & "\Resimler\"
    If SpinButton1.Value > DosyaSayisi(ThisWorkbook.Path & "\Resimler\") Then
        MsgBox "ŞAHSA AİT BAŞKA RESİM YOK"
        UserForm2.Image1.Picture = LoadPicture("")
        Exit Sub
    End If
    resimadi = deg3(Val(SpinButton1.Value))
    resimyükle = hedef & resimadi ' & "." & resimuzantısı(Val(i))
    UserForm1.Image1.ControlTipText = resimyükle
    UserForm1.Image1.Visible = False
    On Error GoTo atla3
    UserForm2.Image1.Visible = True
    UserForm2.Image1.Picture = LoadPicture(resimyükle)
    Exit Sub
atla3:
    UserForm2.Image1.Visible = False
End Sub
Private Sub UserForm_Initialize()

hedef = ThisWorkbook.Path & "\Resimler\"
resimadi = UserForm1.TextBox4.Text
sat = 1
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(hedef).Files
If Mid(dosya.Name, 1, Len(resimadi)) = resimadi Then
sat = sat + 1
deg3(sat) = dosya.Name
End If
Next
SpinButton1.Max = sat
End Sub

Bu kodları ekli dosyama uyguladım ancak SON RESİMDEN sonra "BU ŞAHSA AİT BAŞKA RESİM YOK" mesajını alamıyorum buna bir bakar mısınız? Herkese teşekkürler.
 

Ekli dosyalar

Son düzenleme:
Dosyanızda menü ekleme kodları mevcut bu yüzden hatalar veriyor ayrıca ilk eklediğim kodlar çalışıyorsa; sizin, sonradan eklediğiniz kodları incelemenizi öneririm.
 
Evet doğrudur efendim; Bu dosyayı Korhan Ayhan'ın bir çalışması idi buna uyarlamıştım. O yüzden çalışmadı, bununla yetinelim, Hamitcan bey, ancak sizin yazdığınız koddan sonra şu kodu ilave ettim.
Kod: 
Private Sub UserForm_Initialize()

hedef = ThisWorkbook.Path & "\Resimler\"
resimadi = UserForm1.TextBox4.Text
sat = 1
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder(hedef).Files
If Mid(dosya.Name, 1, Len(resimadi)) = resimadi Then
sat = sat + 1
deg3(sat) = dosya.Name
End If
Next
SpinButton1.Max = sat
End Sub

Bununla çalışmaya başladı daha öncesinden hiç çalışmadı.
Yani sizin yazdığınız şu kod la;
Kod: 
Dim deg3(100)
Private Sub SpinButton1_Change()
    hedef = ThisWorkbook.Path & "\Resimler\"
    If SpinButton1.Value > DosyaSayisi(ThisWorkbook.Path & "\Resimler\") Then
        MsgBox "ŞAHSA AİT BAŞKA RESİM YOK"
        UserForm2.Image1.Picture = LoadPicture("")
        Exit Sub
    End If
    resimadi = deg3(Val(SpinButton1.Value))
    resimyükle = hedef & resimadi ' & "." & resimuzantısı(Val(i))
    UserForm1.Image1.ControlTipText = resimyükle
    UserForm1.Image1.Visible = False
    On Error GoTo atla3
    UserForm2.Image1.Visible = True
    UserForm2.Image1.Picture = LoadPicture(resimyükle)
    Exit Sub
atla3:
    UserForm2.Image1.Visible = False
End Sub

bu kodun sonrasını yukarıda da belirtiğim gibi ekleyince çalıştı. Ancak uyarı mesajı olan "Şahsa ait başka resim yok" mesajını alamadım. Ben kod yazmayı bilmiyorum. Sizden sonraki eklediğim kodu da Halit3 hocam yazmıştı. Sadece bu kodları ekleyerek bir şeyler yapıyorum. Emeği geçen herkese teşekkürler dua ile kalın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst