- Katılım
- 23 Ocak 2007
- Mesajlar
- 6
- Excel Vers. ve Dili
- excel profesyonel 2003
Arkadaşlar merhaba,
İlkönce bu foruma emeği geçen herkese teşekkür etmek istiyorum. Mükerrer kayıt^ta sorun yaşıyorum, aşağıdaki kodlarda nerede hata yaptım bir türlü dün akşamdan bu yana çözemedim. Forumda da aradım ama inanın çözümü bulabileceğim bir koda ulaşamadım. Ayrıca dosyayı da ekliyorum. Yardım ederseniz memnun olurum. İyi çalışmalar dileklerimle...
Private Sub kaydet_Click()
Dim benzer As Range
Dim satırlar As Range
On Error Resume Next
For i = 5 To Sheets("GİRİŞLER").Range("c65536").End(xlUp).Row
If Sheets("GİRİŞLER").Range("c" & i).Value = TextBox11.Text And _
Sheets("GİRİŞLER").Range("f" & i).Value >= TextBox3.Text And _
Sheets("GİRİŞLER").Range("g" & i).Value <= TextBox3.Text Then
MsgBox "Aynı tarihler arası başka izin giremezsiniz...", vbCritical, "MÜKERRER KAYIT BULUNDU"
Exit Sub
End If
Next i
Range("b4").Select
'SIRA NO ATANIYOR
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("b5").Value = "" Then
Range("b5").Value = 1
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
End If
'İZİN BİLGİLERİ VERİ SAYFASINA KAYIT EDİLİYOR.
ActiveCell.Offset(0, 1).Value = TextBox11.Value
ActiveCell.Offset(0, 2).Value = TextBox12.Value
ActiveCell.Offset(0, 3).Value = ComboBox1.Value
ActiveCell.Offset(0, 4).Value = TextBox14.Value
ActiveCell.Offset(0, 5).Value = TextBox3.Value
ActiveCell.Offset(0, 6).Value = TextBox13.Value
ActiveCell.Offset(0, 7).Value = TextBox17.Value
ActiveCell.Offset(0, 8).Value = TextBox15.Value
ActiveCell.Offset(0, 9).Value = TextBox18.Value
ActiveWorkbook.Save
MsgBox "İZİN BİLGİLERİ KAYIT EDİLDİ...", vbInformation, "KAYIT"
İlkönce bu foruma emeği geçen herkese teşekkür etmek istiyorum. Mükerrer kayıt^ta sorun yaşıyorum, aşağıdaki kodlarda nerede hata yaptım bir türlü dün akşamdan bu yana çözemedim. Forumda da aradım ama inanın çözümü bulabileceğim bir koda ulaşamadım. Ayrıca dosyayı da ekliyorum. Yardım ederseniz memnun olurum. İyi çalışmalar dileklerimle...
Private Sub kaydet_Click()
Dim benzer As Range
Dim satırlar As Range
On Error Resume Next
For i = 5 To Sheets("GİRİŞLER").Range("c65536").End(xlUp).Row
If Sheets("GİRİŞLER").Range("c" & i).Value = TextBox11.Text And _
Sheets("GİRİŞLER").Range("f" & i).Value >= TextBox3.Text And _
Sheets("GİRİŞLER").Range("g" & i).Value <= TextBox3.Text Then
MsgBox "Aynı tarihler arası başka izin giremezsiniz...", vbCritical, "MÜKERRER KAYIT BULUNDU"
Exit Sub
End If
Next i
Range("b4").Select
'SIRA NO ATANIYOR
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("b5").Value = "" Then
Range("b5").Value = 1
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0) + 1
End If
'İZİN BİLGİLERİ VERİ SAYFASINA KAYIT EDİLİYOR.
ActiveCell.Offset(0, 1).Value = TextBox11.Value
ActiveCell.Offset(0, 2).Value = TextBox12.Value
ActiveCell.Offset(0, 3).Value = ComboBox1.Value
ActiveCell.Offset(0, 4).Value = TextBox14.Value
ActiveCell.Offset(0, 5).Value = TextBox3.Value
ActiveCell.Offset(0, 6).Value = TextBox13.Value
ActiveCell.Offset(0, 7).Value = TextBox17.Value
ActiveCell.Offset(0, 8).Value = TextBox15.Value
ActiveCell.Offset(0, 9).Value = TextBox18.Value
ActiveWorkbook.Save
MsgBox "İZİN BİLGİLERİ KAYIT EDİLDİ...", vbInformation, "KAYIT"