Resimli listview

Listeleme kutusu. Verileriniz klasör ve dosyalarınızı görsel olarak kontrol edebileceğiniz bir nesne modeli.

Resimli listview

İleti#1)  skat » 23 Mar 2018 12:29

Hayırlı Cumalar arkadaşlar
Müsait olan arkadaşlar bakabilir mi
Userform üzerindeki textboxlara yazdığım bilgileri listviewe kayıt ediyorum, fakat listviewdeki isimlere tıkladığımda resimlerininde
C:\resimler\SITKI YAĞCI.jpg adresinden kişiye ait resmi de alabilirmi acaba ! Teşekkür ederim
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#2)  feraz » 23 Mar 2018 19:52

Kod: Tümünü seç
Private Sub ListView1_Click()

Me.Image1.Picture = LoadPicture("")

If Dir(ThisWorkbook.Path & "\" & Me.ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(2).Text & ".jpg") <> "" Then
    Me.Image1.Picture = LoadPicture _
    (ThisWorkbook.Path & "\" & Me.ListView1.ListItems(ListView1.SelectedItem.Index).ListSubItems(2).Text & ".jpg")
End If

End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Resimli listview

İleti#3)  skat » 24 Mar 2018 11:34

Sayın feraz tam istediğim gibi Allah Cc razı olsun.
Resim ekle butonuna tıklandığı zaman bilgisayarımdan resmin yeri gösterip , o resmi (ThisWorkbook.Path ) klasörüne kayıt yapabilir mi?
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#4)  feraz » 24 Mar 2018 13:33

Sizdende Allah razı olsun.

Kod: Tümünü seç
Private Sub CommandButton8_Click()

Dim resmyol  As String
Dim klasor As FileDialog


With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Sec.."
    .ButtonName = "Sec"
    .InitialFileName = "C:\"
   
        If .Show = -1 Then
            resmyol = .SelectedItems(1)
            Set klasor = Application.FileDialog(msoFileDialogFolderPicker)

        Else
       
            Exit Sub
        End If
End With

If Dir(ThisWorkbook.Path & "\" & Right(resmyol, Len(resmyol) - Len(klasor.InitialFileName))) <> "" Then
    MsgBox "Aynisi var", vbCritical, "Bilgi"
Else
    FileCopy resmyol, ThisWorkbook.Path & "\" & Right(resmyol, Len(resmyol) - Len(klasor.InitialFileName))
End If


End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Resimli listview

İleti#5)  skat » 24 Mar 2018 15:19

Sayın feraz çok çok teşekkür ederim Allah Cc razı olsun ,işinizi gücünüzü rast getirsin inşallah şkşk şkşk
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#6)  feraz » 24 Mar 2018 15:22

Amin.Cümlemizin.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Resimli listview

İleti#7)  feraz » 24 Mar 2018 23:50

Biraz daha iyi olsun diye alttaki gibi yaptım.Başka yöntemde var fakat ayar felan yapılmalı gerek yok.

Çoklu resim yada başka verilerde kopyalayabilirsiniz.

Kod: Tümünü seç
Private Sub CommandButton8_Click()

Dim resmyol  As String
Dim klasor As FileDialog
Dim i As Integer, say As Integer

    Set klasor = Application.FileDialog(msoFileDialogFilePicker)
     say = 0
     
     With klasor
        .AllowMultiSelect = True 'Coklu secim.False olursa tek secilir
        .Title = "Sec.."
        .ButtonName = "Sec"
        .InitialFileName = Environ("USERPROFILE") & "\Desktop\" '"C:\"
       
        .Filters.Clear
        .Filters.Add Description:="Resimler (*.jpg,*.png,*.gif,*.bmp)", Extensions:="*.jpg;*.png,*.gif,*.bmp"
        .Filters.Add "Tümü", "*.*", 1 'Tümü icin
        .FilterIndex = 1
       
            If .Show = -1 Then
           
                For i = 1 To .SelectedItems.Count
                     resmyol = .SelectedItems(i)
                     
                    If Dir(ThisWorkbook.Path & "\" & Right(resmyol, Len(resmyol) - Len(klasor.InitialFileName))) <> "" Then
                        MsgBox "Alttakilerin Aynisi var...Kopyalanmayacak.." & vbLf & vbLf & Right(resmyol, Len(resmyol) - Len(klasor.InitialFileName)), vbCritical, "Bilgi"
                         
                    Else
                        FileCopy resmyol, ThisWorkbook.Path & "\" & Right(resmyol, Len(resmyol) - Len(klasor.InitialFileName))
                        say = say + 1
                    End If
                Next
            Else
                Exit Sub
            End If
    End With

If say > 0 Then
     MsgBox "Islem tamamlandi.." & vbLf & vbLf & " Koyalanan adet: " & say, vbInformation, "Bilgi"
Else
    Set klasor = Nothing
     MsgBox "Hic veri kopyalanmadi..", vbExclamation, "Bilgi"
End If

    Set klasor = Nothing

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Resimli listview

İleti#8)  skat » 25 Mar 2018 14:16

Sayın feraz çok düşüncelisiniz Allah Cc razı olsun bunu kullancağım Allah cc emanet olun
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#9)  skat » 29 Mar 2018 15:13

Sayın feraz image1 resim alırken Texbox3 teki adı soyadını aldığı resim ismi olarak kayıt edebilir mi ?Yani resmi alırken ismini de textbox3 te ki isim ile kayıt edebilir mi?)
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#10)  feraz » 29 Mar 2018 22:15

Merhaba,dener misiniz?

Kod: Tümünü seç
Private Sub CommandButton8_Click()

Dim resmyol, resmyol68, resmUzant
Dim klasor As FileDialog
Dim i As Integer, say As Integer


    Set klasor = Application.FileDialog(msoFileDialogFilePicker)
     say = 0
     
     With klasor
        .AllowMultiSelect = True 'Coklu secim.False olursa tek secilir
        .Title = "Sec.."
        .ButtonName = "Sec"
        .InitialFileName = Environ("USERPROFILE") & "\Desktop\" '"C:\"
       
        .Filters.Clear
        .Filters.Add Description:="Resimler (*.jpg,*.png,*.gif,*.bmp)", Extensions:="*.jpg;*.png,*.gif,*.bmp"
        .Filters.Add "Tümü", "*.*", 1 'Tümü icin
        .FilterIndex = 1
       
        If Me.TextBox3.Value <> Empty Then
            If .Show = -1 Then
                For i = 1 To .SelectedItems.Count
                     resmyol = .SelectedItems(i)
                     resmyol68 = ThisWorkbook.Path & "\" & Me.TextBox3.Value & "." & Split(resmyol, ".")(UBound(Split(resmyol, ".")))
                     resmUzant = Right(resmyol68, Len(resmyol68) - Len(ThisWorkbook.Path & "\"))
                     
                    If Dir(resmyol68) <> "" Then
                        MsgBox "Alttakilerin Aynisi var...Kopyalanmayacak.." & vbLf & vbLf & resmUzant, vbCritical, "Bilgi"
                    Else
                        FileCopy resmyol, resmyol68
                        say = say + 1
                        a = a & resmUzant & vbLf
                    End If
                Next
            Else
                Exit Sub
         End If
      Else
         MsgBox "Textbox3 bos olamaz..", vbCritical, "HATA"
         Exit Sub
      End If
    End With

If say > 0 Then
     MsgBox vbLf & vbLf & " Koyalanan : " & vbLf & vbLf & resmUzant, vbInformation, "Islem tamamlandi.."
Else
    Set klasor = Nothing
'     MsgBox "Hic veri kopyalanmadi..", vbExclamation, "Bilgi"
End If

    Set klasor = Nothing

End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Resimli listview

İleti#11)  feraz » 30 Mar 2018 00:55

Son verdiğim alttaki kodu silebilirsiniz.
Bişey denemiçtim silmeyi unutmuşum :)

Kod: Tümünü seç
a = a & resmUzant & vbLf


Alttaki kod geçerlidir.İsim textbox3 den alınacağı için çoklu kopyalama iptal edilebilir esasen.

İptal için true yerine false yazın yandaki yere.AllowMultiSelect = True

Kod: Tümünü seç
Private Sub CommandButton8_Click()

Dim resmyol, resmyol68, resmUzant
Dim klasor As FileDialog
Dim i As Integer, say As Integer


    Set klasor = Application.FileDialog(msoFileDialogFilePicker)
     say = 0
     
     With klasor
        .AllowMultiSelect = True 'Coklu secim.False olursa tek secilir
        .Title = "Sec.."
        .ButtonName = "Sec"
        .InitialFileName = Environ("USERPROFILE") & "\Desktop\" '"C:\"
       
        .Filters.Clear
        .Filters.Add Description:="Resimler (*.jpg,*.png,*.gif,*.bmp)", Extensions:="*.jpg;*.png,*.gif,*.bmp"
        .Filters.Add "Tümü", "*.*", 1 'Tümü icin
        .FilterIndex = 1
       
        If Me.TextBox3.Value <> Empty Then
            If .Show = -1 Then
                For i = 1 To .SelectedItems.Count
                     resmyol = .SelectedItems(i)
                     resmyol68 = ThisWorkbook.Path & "\" & Me.TextBox3.Value & "." & Split(resmyol, ".")(UBound(Split(resmyol, ".")))
                     resmUzant = Right(resmyol68, Len(resmyol68) - Len(ThisWorkbook.Path & "\"))
                     
                    If Dir(resmyol68) <> "" Then
                        MsgBox "Alttakilerin Aynisi var...Kopyalanmayacak.." & vbLf & vbLf & resmUzant, vbCritical, "Bilgi"
                    Else
                        FileCopy resmyol, resmyol68
                        say = say + 1
                    End If
                Next
            Else
                Exit Sub
         End If
      Else
         MsgBox "Textbox3 bos olamaz..", vbCritical, "HATA"
         Exit Sub
      End If
    End With

If say > 0 Then
     MsgBox vbLf & vbLf & " Koyalanan : " & vbLf & vbLf & resmUzant, vbInformation, "Islem tamamlandi.."
Else
    Set klasor = Nothing
'     MsgBox "Hic veri kopyalanmadi..", vbExclamation, "Bilgi"
End If

    Set klasor = Nothing

End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Resimli listview

İleti#12)  skat » 30 Mar 2018 01:53

Sayın feraz uzun zamandan beri bu dosya üzerinde çalıştım .Sizin sayenizde bitirdim problemsiz çalışıyor.Allah Cc razı olsun.Artık bir duacınız var şkşk
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#13)  feraz » 30 Mar 2018 01:57

Sizdende Allah razı olsun.

Bende anlamam kodlardan fazla.
Bildiklerimden oldu bişeyler :)
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Resimli listview

İleti#14)  skat » 30 Mar 2018 13:31

Sayın feraz'a katkılarından dolayı çok teşekkür ederim.Dosyanın son halini paylaşıyorum
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#15)  skat » 01 Nis 2018 23:23

Sayın feraz çok mu oluyorum , özür dilerim .
userforma Textbox12'yi ekledim yanınada Label 13'ü ekledim.Label 13 te listviewde doğum günü gelen personel için uyarı verebilir mi. Değiştir butonu textbox 12'i değiştirmiyor. Teşekkür ederim.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#16)  feraz » 02 Nis 2018 01:07

Özüre gerek yok üstadım.

Herzaman sorabilirsiniz.

Her türlü uyarı yaptırttım. UserForm_Initialize() kodundakileri gereksiz uyarıları silebilirsiniz.

Birde For i = 1 To c olan yeri For i = 1 To c - 1 yaptım.

Değiştirmeyide yaptım.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Cevap: Resimli listview

İleti#17)  feraz » 02 Nis 2018 01:12

feraz yazdı:Özüre gerek yok üstadım.

Herzaman sorabilirsiniz.

Her türlü uyarı yaptırttım. UserForm_Initialize() kodundakileri gereksiz uyarıları silebilirsiniz.

Birde For i = 1 To c olan yeri For i = 1 To c - 1 yaptım.

Değiştirmeyide yaptım.


Bunu indiriniz kodlar aynı.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Resimli listview

İleti#18)  skat » 02 Nis 2018 01:17

Çok teşekkür ederim Allah Cc ne muradınız varsa versin.İnşallah
Hayırlı geceler .
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Cevap: Resimli listview

İleti#19)  feraz » 02 Nis 2018 01:21

Amin sizinde.

Hayırlı geceler.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5156
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Resimli listview

İleti#20)  skat » 05 Nis 2018 01:17

Hayırlı geceler Sayın feraz ;
Label13 te doğum günü yazan isimlere tıklayınca ,o kişin bilgileri textboxlara ve resmi imageye resmi gelebilir mi ?
Kullanıcı avatarı
skat
Siteye Alışmış
 
Adı Soyadı:SITKI YAĞCI
Kayıt: 15 Haz 2008 02:17
Konum: ereğli
Meslek: I. Kademe Vardiya amiri/Yönetici
Yaş: 43
İleti: 217
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Kdz.Ereğli

Sonraki

Forum ListView

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 3 misafir

cron
Bumerang - Yazarkafe