sirkülasyon
Altın Üye
- Katılım
- 10 Temmuz 2012
- Mesajlar
- 2,532
- Excel Vers. ve Dili
- 2021 LTSC TR
- Altın Üyelik Bitiş Tarihi
- 18-06-2026
Kod:
Özel Abone Kaydet_Click()
'mesaj kutusu devreye giriyor.
If MsgBox("Bu kayıt kayıt dosyası kaydedilecek mi?", vbYesNo) = vbNo Sonra Çıkış Sub
As Çalışma Sayfasını Dim, Tamsayı Olarak Say, ara As String, bul As Range, x As Integer
Set a = Worksheets("Kayıt")
Say = Application.WorksheetFunction.CountIfs(a.Range("B:B")), TextBox17, _
a.Range("P:P"), IIf(TextBox18 = "", "*", TextBox18), _
a.Range("G:G"), IIf(TextBox5 = "", "*", TextBox5), _
a.Range("H:H"), IIf(TextBox6 = "", "*", TextBox6))
> 0 ise O zaman
If MsgBox("Bu kayıt daha önce yapılmış!" & vbLf & "Yine de işlemeye devam etmek istiyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2) = vbNo Then
MsgBox "Kayıt işlemi iptal edilmiştir.", vbInformation
Alttan Çık
Eğer Sonlandır
Eğer Sonlandır
Say = WorksheetFunction.CountA(a.Range("A2:A65536")) + 1
a.Hücreler(Say + 1, 1).Değer = Say
a.Cells(Say + 1, 2).Value = TextBox17.Value
a.Cells(Say + 1, 3).Value = TextBox1.Value
a.Cells(Say + 1, 4).Value = TextBox2.Value
a.Cells(Say + 1, 5).Value = TextBox16.Value
a.Cells(Say + 1, 6).Value = TextBox4.Value
a.Cells(Say + 1, 7).Value = TextBox5.Value
a.Cells(Say + 1, 8).Value = TextBox6.Value
a.Cells(Say + 1, 9).Value = TextBox7.Value
a.Cells(Say + 1, 10).Value = TextBox8.Value
a.Cells(Say + 1, 11).Value = TextBox9.Value
a.Cells(Say + 1, 12).Value = TextBox10.Value
a.Cells(Say + 1, 13).Value = TextBox11.Value
a.Cells(Say + 1, 14).Value = TextBox12.Value
a.Cells(Say + 1, 15).Value = TextBox13.Value
a.Cells(Say + 1, 16).Value = TextBox18.Value
ActiveWorkbook.Save
MsgBox "Bu kayıt kayıt listesi kaydedildi", vbCritical, "UYARI"
Hata Durumunda Devam Ettirin Sonraki
Kod:
If MsgBox("Bu kayıt daha önce yapılmış!" & vbLf & "Yine de işlemeye devam etmek istiyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2) = vbNo Then
Rica etsem bana yardımcı olabilir misiniz?
Son düzenleme: