Sil ve Yenile Makrosu...!!!

[ocamsul]

Arkadaşlar bu gün bu KASA çalışmasında epey yol aldım. Ancak; aşağıda sil Macrosunda bir sorun var sanırsam. If ListBox1.ListIndex = -3 satırının bu bölümünü renklendirip hata veriyo. sorun nedir arkadaşlar yardımlarınızı bekliyorum.

Sub sil()
sat = ListBox1.ListIndex + 4
Cevap = MsgBox("SİLMEK İSTEDİĞİNİZDEN EMİNMİSİNİZ!", vbYesNo, "")
If Cevap = vbNo Then Exit Sub
Rows(sat).EntireRow.Delete
son = [c65536].End(3).Row
For i = 4 To son
Cells(i, 3) = i - 3
Next
Call yenile
End Sub

Sub yenile()
son = [c65536].End(3).Row
ListBox1.Clear
For x = 4 To son
ListBox1.AddItem Cells(x, 3)
Next
End Sub

Sn: COST_CONTROL Biraz çabayla sıralama işini hallettim. Ancak sıralama işlemini yaptıktan sonra ListBox1.Clear satırı için hata veriyor. Bu neden olabilir acaba?

 

[ocamsul]

Arkadaşlar benim burada yapmak istediğim; SİL işleminden sonra KASAGİRİŞ sayfasında c4 hücresinden itibaren sıralamanın tekrar yapılmaası.

 

[Korhan Ayhan]

Selamlar,

Bu şekilde cevap vermek zor. Örnek bir dosya üzerinde nasıl bir çözüm istediğinizi tarif edermisiniz.

 

[ocamsul]

Sn: COST_CONTROL yukarıdaki kodlarda gerekli düzenlemeleri yaptım. şimdi sadece ListBox1.Clear satırındaki hata nedenini bulamadım. bu satır için tüm işlemleri yaptıktan sonra hata veriyor.

 

[ocamsul]

Dostlar bu ListBox1.Clear satırı neden hata veriyor? bir türlü nulamadım.

 

[Recep İpek]

Kodları aşağıdaki şekilde deneyebilirmisiniz.

Sub yenile()
sonu = [c65536].End(3).Row
UserForm1.ListBox1.Clear
For X = 4 To sonu
UserForm1.ListBox1.AddItem Cells(X, 3)
Next
End Sub

 

[ocamsul]

Sn: ripek bu da çözüm olmadı aynı hatayı tekrar verdi.

Konu ile ilgili tüm kodlar :

Private Sub ComboBox1_Change()
If ComboBox1.ListIndex = -1 Then Exit Sub
'########################################
'Seçilen Personelin bilgileri UserForm'a aktarılıyor
'########################################
With Sheets("VERGİ")
TextBox2.Value = .Cells(ComboBox1.ListIndex + 2, 2)
End With
'############## BİTTİ ###################
End Sub

Private Sub CommandButton1_Click()
For X = 8 To 15
If Controls("TextBox" & X).Value = Empty Then
MsgBox ("Kayıt işlemi için gerekli tüm bilgileri girmelisiniz!" _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri düzenleyiniz."), vbExclamation, "Dikkat!!! KaSaV1.0"
Controls("TextBox" & X).SetFocus
Exit Sub
End If
Next
Sheets("HESAP").Select
Range("a2").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(0, 1).Text = TextBox8.Text Then
MsgBox "Seçmiş olduğunuz Hesap kaydı zaten var!!!"
Exit Sub
End If
Loop
If Range("A4").Value = "" Then
Range("A4").Value = 1
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
'..........................................................
'Textbox kutularındaki verileri hücrelere yazdırır.
ActiveCell.Offset(0, 1).Value = TextBox8.Value
ActiveCell.Offset(0, 2).Value = TextBox9.Value
ActiveCell.Offset(0, 3).Value = TextBox10.Value
ActiveCell.Offset(0, 4).Value = TextBox11.Value
ActiveCell.Offset(0, 5).Value = TextBox12.Value
ActiveCell.Offset(0, 6).Value = TextBox13.Value
ActiveCell.Offset(0, 7).Value = TextBox14.Value
ActiveCell.Offset(0, 8).Value = TextBox15.Value
ActiveCell.Offset(0, 9).Value = TextBox16.Value
ActiveCell.Offset(0, 10).Value = TextBox17.Value
ActiveCell.Offset(0, 11).Value = TextBox18.Value
ActiveCell.Offset(0, 12).Value = TextBox19.Value
UserForm1.MultiPage1.Value = 0
End Sub

Private Sub CommandButton2_Click()
Sheets("KASAGİRİŞ").Select
If OptionButton1.Value = False And OptionButton2.Value = False Then
MsgBox "Kayıt işlemi için sayfa seçimi yapmalısınız.", vbExclamation, "DİKKAT !"
Exit Sub
End If
If OptionButton1.Value = True Then Sheets("KASAGİRİŞ").Select
If OptionButton2.Value = True Then Sheets("KASAÇIKIŞ").Select
Range("C3").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
If ActiveCell.Offset(1, 2).Text = ComboBox2.Text Then
MsgBox "Seçmiş olduğunuz kayıt zaten var!!!"
Exit Sub
End If
Loop
If Range("d4").Value = "" Then
Range("C4").Value = 1
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1).Value = ComboBox2.Value
ActiveCell.Offset(0, 2).Value = TextBox1.Value
ActiveCell.Offset(0, 3).Value = ComboBox1.Value
ActiveCell.Offset(0, 4).Value = TextBox2.Value
ActiveCell.Offset(0, 5).Value = TextBox3.Value
ThisWorkbook.Save
End Sub

Private Sub CommandButton3_Click()
Sheets("KASAGİRİŞ").Select
sifre = InputBox("Kodların çalışması için şifre gerekiyor", _
"Yetkili Kişi", "Şifreyi buraya yazınız.")
If sifre = "excel" Then 'şifre
MsgBox "Şifre doğrulandı", vbInformation, _
"Şifre Doğru"
Else
MsgBox "Yanlış şifre girdiniz." & Chr(13) & _
"Kod çalışması iptal edildi", vbCritical, "Yanlış şifre"
Cancel = True
End If
sil
End Sub

Private Sub ToggleButton5_Click()
On Error Resume Next
Dim Soru As String
Soru = MsgBox("KaSaV1.0 Programından Çıkmak İstediğinizden Eminmisiniz ?", vbQuestion + vbYesNo, "UYARI...!!!")
If Soru = vbYes Then Unload UserForm1
If Soru = vbNo Then UserForm1.Show
ThisWorkbook.Save
Application.Quit
End Sub

Private Sub ToggleButton6_Click()
UserForm2.Show
End Sub

Private Sub UserForm_Initialize()
UserForm1.MultiPage1.Value = 0
ComboBox2.SetFocus
ComboBox1.RowSource = "VERGİ!a2:a" & WorksheetFunction.CountA(Sheets("VERGİ").Range("a2:a65000"))
ComboBox2.RowSource = "HESAP!B4:B" & [HESAP!B65536].End(3).Row
ListBox3.RowSource = "VERGİ!a2:b300"
ListBox3.ColumnCount = 10
ListBox3.ColumnWidths = "100"
ListBox3.ColumnHeads = True
ListBox3.ColumnWidths = "50;80"
ListBox1.RowSource = "KASAGİRİŞ!c4:h300"
ListBox1.ColumnCount = 6
ListBox1.ColumnWidths = ""
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "40;60;60;60;260;50"
ListBox2.RowSource = "KASAÇIKIŞ!c4:h300"
ListBox2.ColumnCount = 10
ListBox2.ColumnWidths = "100"
ListBox2.ColumnHeads = True
ListBox2.ColumnWidths = "40;60;60;60;260;50"
ListBox4.RowSource = "HESAP!B4:B" & [HESAP!B65536].End(3).Row
ListBox4.ColumnCount = 1
ListBox4.ColumnWidths = "50"
ListBox4.ColumnHeads = True
ListBox4.ColumnWidths = "80"
Label14 = Format(Date, "dd.mm.yyyy")
Sheets("KASAGİRİŞ").Select
Range("c4").Activate
TextBox7 = WorksheetFunction.CountA(Columns("C")) + 1 - 3
End Sub

Sub sil()
sat = ListBox1.ListIndex + 4
Cevap = MsgBox("SİLMEK İSTEDİĞİNİZDEN EMİNMİSİNİZ!", vbYesNo, "")
If Cevap = vbNo Then Exit Sub
Rows(sat).EntireRow.Delete
son = [c65536].End(3).Row
For i = 4 To son
Cells(i, 3) = i - 3
Next
Call yenile
End Sub

Sub yenile()
sonu = [c65536].End(3).Row
UserForm1.ListBox1.Clear
For X = 4 To sonu
UserForm1.ListBox1.AddItem Cells(X, 3)
Next
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
sil
End Sub

 

[Korhan Ayhan]

Selamlar,

Sanırım ListBox1 e verilerinizi RowSource ile alıyorsunuz. Eğer işleminiz bu şekilde ise hata mesajını bu yüzden alıyorsunuz. Bu hatayı gidermek için ListBox1.Clear satırı yerine ListBox1.RowSource="" satırını yazıp denermisiniz.

Not: Eğer ListBox1 e verileri Additem yöntemi ile alıyorsanız temizlemek için ListBox1.Clear komutunu RowSource yöntemi ile alıyorsanız ListBox1.RowSource="" komutunu kullanmanız gerekir.

 

[ocamsul]

Sn: COST_CONTROL Evet hocam mesajınızı görmemiştim. Dün akşam çözdüm olayı doğru kodlar;

Sub sil()
sat = ListBox1.ListIndex + 4
Cevap = MsgBox("SİLMEK İSTEDİĞİNİZDEN EMİNMİSİNİZ!", vbYesNo, "")
If Cevap = vbNo Then Exit Sub
Rows(sat).EntireRow.Delete
son = [c65536].End(3).Row
For i = 4 To son
Cells(i, 3) = i - 3
Next
Call yenile
End Sub

Sub yenile()
son = [c65536].End(3).Row
ListBox1.RowSource = "KASAGİRİŞ!c4:h300"
For x = 3 To son
Next
MsgBox "Seçmiş Olduğunuz Kayıt Veri Tabanından Silinmiştir.", vbExclamation, "DİKKAT !"
ListBox1.RowSource = "KASAGİRİŞ!c4:h300"
End Sub

Şeklinde olduğunda çalıştı. İlginizi ve yardımlarınıza teşekkürler hocam.