Basit bir gelir gider tablosu yapmaya çalışıyorum.Korhan hocamızın Personel kayıt programından kendime uyarlamaya çalıştığım listboxtaki kayıt silme işleminde şöyle bir hata veriyor. Listboxta bulunan ilk üç satırı sidiğimde (üçten fazla kayıt varsa hata vermiyor!) debug hatası veriyor ve vba sayfasında aşağıdaki kodu sarı renge boyuyor.
Range("A2").AutoFill Destination:=Range("A2:A" & Range("A1000000").End(3).Row), Type:=xlFillSeries
Gelirler sayfası
SIRA K. TARİHİ İŞ. DÖNEMİ MİKTAR açıklama AÇIKLAMA
2 11.3.2016 11.3.2016 1500,00 ₺ deneme deneme
3 11.3.2016 11.3.2016 1500,00 ₺ deneme deneme
Kullandığım kayıt silme kodu
Private Sub CommandButton5_Click() 'KAYIT SİL TUŞU (ListBox üzerinde seçilen kayıdı silmek için kullanılmaktadır.)
'1 - ListBox nesnesinde veri olup olmadığını kontrol ediyoruz.
If ListBox1 = Empty Then
MsgBox "Veri kaydı bulunamamıştır.", vbExclamation, "Dikkat !"
Exit Sub
End If
'2 - ListBox nesnesinden seçim yapılıp yapılmadığını kontrol ediyoruz.
If ListBox1.ListIndex < 0 Then
MsgBox "Lütfen listeden veri seçimi yapınız.", vbExclamation, "Dikkat !"
Exit Sub
End If
'3 - Yapılacak silme işlemi için kullanıcıdan onay alıyoruz.
If MsgBox("Seçtiğiniz kayıt silinecektir onaylıyor musunuz ?", vbCritical + vbYesNo, "Dikkat !") = vbYes Then
'4 - ListBox nesnesinde kayıtları temizliyoruz.
ListBox1.RowSource = Empty
'5 - Eğer kullanıcı silme işlemi için onay vermişse aktif satırdaki verileri siliyoruz.
Range("A" & ActiveCell.Row, "F" & ActiveCell.Row).ClearContents
'6 - Kayıt silme işleminde sıra numarası düzeni bozulacağı için verileri sıralayarak yeniden sıra numarası veriyoruz.
Range("A2:F1000000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A2") = 1
Range("A2").AutoFill Destination:=Range("A2:A" & Range("A1000000").End(3).Row), Type:=xlFillSeries
'7 - VERİ sayfasındaki verileri ListBox nesnesine yüklüyoruz.
With GELİR_FORMU.ListBox1
.BackColor = vbGreen
.ColumnCount = 6
.ColumnWidths = "45;120;120;100;200;200"
.ForeColor = vbBlack
If Sheets("GELİRLER").Range("A1") = Empty Then
.RowSource = Empty
Else
.RowSource = "GELİRLER!A1:F" & [GELİRLER!A1000000].End(3).Row
End If
End With
MsgBox "Kayıt silme işlemi tamamlanmıştır.", vbInformation, "Kayıt Silme İşlemi"
Else
MsgBox "Kayıt silme işlemi iptal edilmiştir.", vbInformation, "İşlem İptali"
End If
End Sub
Range("A2").AutoFill Destination:=Range("A2:A" & Range("A1000000").End(3).Row), Type:=xlFillSeries
Gelirler sayfası
SIRA K. TARİHİ İŞ. DÖNEMİ MİKTAR açıklama AÇIKLAMA
2 11.3.2016 11.3.2016 1500,00 ₺ deneme deneme
3 11.3.2016 11.3.2016 1500,00 ₺ deneme deneme
Kullandığım kayıt silme kodu
Private Sub CommandButton5_Click() 'KAYIT SİL TUŞU (ListBox üzerinde seçilen kayıdı silmek için kullanılmaktadır.)
'1 - ListBox nesnesinde veri olup olmadığını kontrol ediyoruz.
If ListBox1 = Empty Then
MsgBox "Veri kaydı bulunamamıştır.", vbExclamation, "Dikkat !"
Exit Sub
End If
'2 - ListBox nesnesinden seçim yapılıp yapılmadığını kontrol ediyoruz.
If ListBox1.ListIndex < 0 Then
MsgBox "Lütfen listeden veri seçimi yapınız.", vbExclamation, "Dikkat !"
Exit Sub
End If
'3 - Yapılacak silme işlemi için kullanıcıdan onay alıyoruz.
If MsgBox("Seçtiğiniz kayıt silinecektir onaylıyor musunuz ?", vbCritical + vbYesNo, "Dikkat !") = vbYes Then
'4 - ListBox nesnesinde kayıtları temizliyoruz.
ListBox1.RowSource = Empty
'5 - Eğer kullanıcı silme işlemi için onay vermişse aktif satırdaki verileri siliyoruz.
Range("A" & ActiveCell.Row, "F" & ActiveCell.Row).ClearContents
'6 - Kayıt silme işleminde sıra numarası düzeni bozulacağı için verileri sıralayarak yeniden sıra numarası veriyoruz.
Range("A2:F1000000").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("A2") = 1
Range("A2").AutoFill Destination:=Range("A2:A" & Range("A1000000").End(3).Row), Type:=xlFillSeries
'7 - VERİ sayfasındaki verileri ListBox nesnesine yüklüyoruz.
With GELİR_FORMU.ListBox1
.BackColor = vbGreen
.ColumnCount = 6
.ColumnWidths = "45;120;120;100;200;200"
.ForeColor = vbBlack
If Sheets("GELİRLER").Range("A1") = Empty Then
.RowSource = Empty
Else
.RowSource = "GELİRLER!A1:F" & [GELİRLER!A1000000].End(3).Row
End If
End With
MsgBox "Kayıt silme işlemi tamamlanmıştır.", vbInformation, "Kayıt Silme İşlemi"
Else
MsgBox "Kayıt silme işlemi iptal edilmiştir.", vbInformation, "İşlem İptali"
End If
End Sub