• DİKKAT

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

Adres Defteri Yardım...

I

ileri

Katılım
22 Kasım 2009
Mesajlar
129
Excel Vers. ve Dili
excell 2003 2000 2007
Arkadaşlar Sizin Yardımlarınızla yapmıs oldugum adres defterini sizlerle paylaşmak istiyorum fakat yapmadıgım birkaç nokta var yardımcı olurmusunuz.

1- ListView1'den Sildiginizde Kayıtı Excel Sayfasında Gözüküyor.
2-Sırano Kısmı Yaptım Oradada Adı Soyadı Yazılı oaln a Satrınını SAyıyor Kayıtları EMsela İlk Kayıt Yapıyorusnuz onu otomatikman 2 yapıyor Çok Ugrastım Fakat Çözemedim Kodda Hata var Galiba.
Adres Defterine Giriş şifresi:demo dur.
 

Ekli dosyalar

Son düzenleme:
Selamlar,

Kullandığınız kodlar kayıdı sayfa üzerinden silmiyor. Sadece "A" sütununa "S" harfini yazarak kayıdı silinmiş olarak işaretliyor. Eğer kayıdın sayfadan da tamamen silinmesini istiyorsanız kullandığınız kodu değiştirmeniz gerekiyor.

İkinci sorunuza gelince;

Sizin kodlarınızı aşağıdaki kodlarla değiştirip deneyin.

Kod: 
Private Sub CommandButton6_Click()
Dim cev As Integer
cev = MsgBox("Bu Bilgileri Sileyim mi?", vbInformation + vbYesNo, "Kayıt Silme Bölümü")
If cev = 6 Then
   m = Label1 'aktifkayit
   With Sheets("sayfa1")
       .Cells(m + 1, 1) = "S"
   End With
   aktifkayit = aktifkayit - 1
   CommandButton1_Click
   CommandButton3_Click
End If
End Sub

Kod: 
Private Sub ListView1_Click()
On Error Resume Next
If ListView1.ListItems.Count = 0 Then Exit Sub
Label1 = ListView1.SelectedItem.Index
If Not ListView1.SelectedItem Is Nothing Then
   TextBox1 = ListView1.SelectedItem.SubItems(1)
   TextBox2 = ListView1.SelectedItem.SubItems(2)
   TextBox3 = ListView1.SelectedItem.SubItems(3)
   TextBox4 = ListView1.SelectedItem.SubItems(4)
   TextBox5 = ListView1.SelectedItem.SubItems(5)
   TextBox6 = ListView1.SelectedItem.SubItems(6)
   TextBox7 = ListView1.SelectedItem.SubItems(7)
   TextBox8 = ListView1.SelectedItem.SubItems(8)
   TextBox9 = ListView1.SelectedItem.SubItems(9)
   TextBox10 = ListView1.SelectedItem.SubItems(10)
   TextBox11 = ListView1.SelectedItem.SubItems(11)
   TextBox12 = ListView1.SelectedItem.SubItems(12)
Else
   TextBox1 = ""
   TextBox2 = ""
   TextBox3 = ""
   TextBox4 = ""
   TextBox5 = ""
   TextBox6 = ""
   TextBox7 = ""
   TextBox8 = ""
   TextBox9 = ""
   TextBox10 = ""
   TextBox11 = ""
   TextBox12 = ""
End If
End Sub
 
Malesef SAdece Kayıt durmu Yerine 's' Yazıyor Koble Hem Excel Den Hemde ListView1 den Silmek Mümkünmü... acaba Verdiğiniz kod işe Yaramadı.
 
Selamlar,

Önerdiğim kod sıra no ile yaşadığınız sıkıntıya çözüm olması gerekiyor. Silme işlemi için size bir kod önermemiştim.
 
ileri' Alıntı:
Arkadaşlar Sizin Yardımlarınızla yapmıs oldugum adres defterini sizlerle paylaşmak istiyorum fakat yapmadıgım birkaç nokta var yardımcı olurmusunuz.

1- ListView1'den Sildiginizde Kayıtı Excel Sayfasında Gözüküyor.
2-Sırano Kısmı Yaptım Oradada Adı Soyadı Yazılı oaln a Satrınını SAyıyor Kayıtları EMsela İlk Kayıt Yapıyorusnuz onu otomatikman 2 yapıyor Çok Ugrastım Fakat Çözemedim Kodda Hata var Galiba.
Adres Defterine Giriş şifresi:demo dur.

Şimdiden Yardımlarınızı Bekliyorum Bu Çalışmamda Yardımcı Olan Arkadaşlar
Halit3 ve Korhan Ayhan ARkadaşımızada Teşekkür ederim.
Genişletmek için tıkla ...

sorularınızı isim belirtmeden sorunuz.?

ekli dosyaya bir bakınız.
 

Ekli dosyalar

Halit3 Bey Bilmiyordum Söyledigin için ve yardımcı odlugun için teşekkür ederim bu calısmada yardıcmı oldugunuz için isimlerinizi yazdım birdaha yazmam bu arada verdiginiz kod işe yarıyor teşkkür ederim..
 
bu dosyaya bir tane birinci sütunu süzen nesne ekledim ve kodları döngü ile kısalttım.
 

Ekli dosyalar

Yaptıgınız Bul Arama Yeri Güzel Olmus Fakat Onu Ad soyat arata bilirmyim o yeri nasıl değiştire bilirim.
 
kırmızı olan yer kolon numarası onu kendi arıyacağınız kolana göre değiştirebilirsiniz.

If UCase(Replace(Replace(Text.Text, "I", "İ"), "i", "I")) = UCase(Replace(Replace(Sheets("sayfa1").Cells(i, 1), "I", "İ"), "i", "I")) Then
Genişletmek için tıkla ...

veya

If UCase(Replace(Replace(Text.Text, "I", "İ"), "i", "I")) = UCase(Replace(Replace(Sheets("sayfa1").Cells(i, "A"), "I", "İ"), "i", "I")) Then
Genişletmek için tıkla ...
 
Yardımlarınız İçin Teşkkürler Verdiginiz kod'u istediginiz gibi Değiştiridm dosya no adlı bölüme kayıt durumu geliyor çalışmamın güncelledim bi bakarsanız sevinirim
Birde bir ricam olucaktır. Olurmu Olmazmı Bilmiyorum ama. Sormak istedim.
Kayıt Olurken Dosya no, Adı Soyadı , vergi dairesi , tc no Bunları Şartlandıra bilinirmi tc no yazılmadıysa kaydetmemesi gibi bu bir ricadır sakın yanlış anlamayınız.. Şimdiden Herkese Teşekkür ederim.

Not: Parola demo
 

Ekli dosyalar

Son düzenleme:
bu koda bakınız.

Private Sub CommandButton2_Click()
If TextBox3.Text = "" Then
MsgBox "Adı soyadı boş geçemez."
Exit Sub
End If
If TextBox6.Text = "" Then
MsgBox "T.C. Kimlik numarası dolu olmalı"
Exit Sub
End If

If IsNumeric(TextBox6.Text) <> True Then
MsgBox "T.C. Kimlik numarası sayı olmalı"
Exit Sub
End If

If Len(TextBox6.Text) <> 11 Then
MsgBox "T.C. Kimlik numarası 11 karekter olmalı"
Exit Sub
End If
Dim m, cev As Integer
cev = MsgBox("Bu Bilgileri Kayd Edeyimmi?", vbInformation + vbYesNo, "Kayıt Girişi Bölümü")
If cev = 6 Then
sat = Worksheets("sayfa1").Cells(Rows.Count, "A").End(3).Row + 1
sut = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For i = 1 To sut
Sheets("sayfa1").Cells(sat, i) = Controls("Textbox" & i).Value
Next
Sheets("sayfa1").Cells(sat, 2).Value = sat - 1
End If
CommandButton1_Click
CommandButton3_Click
End Sub
 
halit3' Alıntı:
bu koda bakınız.

Private Sub CommandButton2_Click()
If TextBox3.Text = "" Then
MsgBox "Adı soyadı boş geçemez."
Exit Sub
End If
If TextBox6.Text = "" Then
MsgBox "T.C. Kimlik numarası dolu olmalı"
Exit Sub
End If

If IsNumeric(TextBox6.Text) <> True Then
MsgBox "T.C. Kimlik numarası sayı olmalı"
Exit Sub
End If

If Len(TextBox6.Text) <> 11 Then
MsgBox "T.C. Kimlik numarası 11 karekter olmalı"
Exit Sub
End If
Dim m, cev As Integer
cev = MsgBox("Bu Bilgileri Kayd Edeyimmi?", vbInformation + vbYesNo, "Kayıt Girişi Bölümü")
If cev = 6 Then
sat = Worksheets("sayfa1").Cells(Rows.Count, "A").End(3).Row + 1
sut = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For i = 1 To sut
Sheets("sayfa1").Cells(sat, i) = Controls("Textbox" & i).Value
Next
Sheets("sayfa1").Cells(sat, 2).Value = sat - 1
End If
CommandButton1_Click
CommandButton3_Click
End Sub
Genişletmek için tıkla ...
Dediklerinizi Yaptım Fakat şidmi Çok Enterasan Bir sorun Çıktı Arama Yapıyorum dosya Aratıyorum Kayıt AD ve soyad Olarak aaratıom buluyor Ama Liswin1 dede kayıt durumu çıkıyor bu durum dada user frm dada dosya no olan txtbox yerine kayıt durumu olarak "K" harfi geliyor:s yardımcı olurmusunuz.
Dosyayı bir önceki mesajımda güncelledim.
 
kodları kaydırmak gerekiyor
kırmızı yerleri ben kaydırdım dosyana uygula

Private Sub ListView1_Click()
On Error Resume Next
If ListView1.ListItems.Count = 0 Then Exit Sub
x = ListView1.SelectedItem.Index
Label1 = ListView1.ListItems(x)
If Not ListView1.SelectedItem Is Nothing Then
TextBox1 = ListView1.SelectedItem.SubItems(2)
TextBox2 = ListView1.SelectedItem.SubItems(3)
TextBox3 = ListView1.SelectedItem.SubItems(4)
TextBox4 = ListView1.SelectedItem.SubItems(5)
TextBox5 = ListView1.SelectedItem.SubItems(6)
TextBox6 = ListView1.SelectedItem.SubItems(7)
TextBox7 = ListView1.SelectedItem.SubItems(8)
TextBox8 = ListView1.SelectedItem.SubItems(9)
TextBox9 = ListView1.SelectedItem.SubItems(10)
TextBox10 = ListView1.SelectedItem.SubItems(11)
TextBox11 = ListView1.SelectedItem.SubItems(12)
TextBox12 = ListView1.SelectedItem.SubItems(13)

Else
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
TextBox4 = ""
TextBox5 = ""
TextBox6 = ""
TextBox7 = ""
TextBox8 = ""
TextBox9 = ""
TextBox10 = ""
TextBox11 = ""
TextBox12 = ""

End If
End Sub
Genişletmek için tıkla ...
 
Çok teşekkürler allah Razı Olsun Çok Güzel oldu Çalışmam. Walla Çok teşekkür Ederim Sizlere
 
13 nolu mesajdaki kodu kullanma onun yerine arama kodunu değiştir.

Private Sub ListeGuncelle3()

ListView1.View = lvwReport
ListView1.ListItems.Clear
ListView1.ColumnHeaders.Clear
ListView1.Gridlines = True
ListView1.FullRowSelect = True
ListView1.LabelEdit = lvwManual
sut = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
With ListView1.ColumnHeaders
.Add , , "Satır No", 1
For j = 2 To sut
.Add , , Sheets("sayfa1").Cells(1, j)
Next j
End With

With ListView1
For i = 2 To Worksheets("sayfa1").Cells(Rows.Count, "A").End(3).Row
aranan1 = UCase(Replace(Replace(Text.Text, "I", "İ"), "i", "I"))
aranan2 = UCase(Mid(Replace(Replace(Sheets("sayfa1").Cells(i, 3), "I", "İ"), "i", "I"), 1, Len(Text.Text)))
If aranan1 = aranan2 Then
k = k + 1
.ListItems.Add , , i
For j = 1 To sut - 1
.ListItems(k).SubItems(j) = Sheets("sayfa1").Cells(i, j + 1)
Next j
End If
Next i
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
Label4.Caption = "Toplam " & ListView1.ListItems.Count & " Kayıt Var"
If Text.Text = "" Then
CommandButton3_Click
End If
End Sub
Genişletmek için tıkla ...
 
Teşekkürler güzel Bir Çalışma oldu size bir sorum olucak eger bu arama motorunda bir sorun var ben anlamaıdm kayıt ı büyük harfle yazdıgımızda aramamotorunada ufak harfle yazınca bulmmuyor acaba buun bir çözümü olabilirmi...
 
ileri' Alıntı:
Teşekkürler güzel Bir Çalışma oldu size bir sorum olucak eger bu arama motorunda bir sorun var ben anlamaıdm kayıt ı büyük harfle yazdıgımızda aramamotorunada ufak harfle yazınca bulmmuyor acaba buun bir çözümü olabilirmi...
Genişletmek için tıkla ...

13 nolu mesajdaki kodu hiç denemediğiniz anlaşılıyor sizin bu sorunuza cevap olacaktır.
 
Denedi ama kayıt büyük hafle yapılmıssa arama motorundada büyük hafle buluyor yada ufak harfle yapılmıssada ufak harfle buluyor :s yardımlarınız için yinede sağol
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst