EVRAK NO

Katılım
8 Ekim 2004
Mesajlar
317
Excel Vers. ve Dili
EXCEL 2003 TÜRKÇE
Otomatik üretilen sayıların birden fazla üretilmesini engellemek istiyorum.
Ã?rneğin 1 nolu sayı üretilip Evrak defteri sayfasına yazdırılmış olsun olmaz ama manuel olarak yanlışlıkla bu sayıyla bir kayıt daha yapılmaya çalışılınca kullanıcının uyarılmasını istiyorum.

Aşağıdaki makroyla bunu yapmaya çalıştım ama olmadı makroda düzeltme yapabilirmisiniz teşekkürler


Kod:
Private Sub CommandButton1_Click()
'Bu kodla aynı evrak numarasının birden fozla verdirilmesini engellemek istiyorum olmadı
If TextBox3.Value <> "" Then
Sheets("EVRAK DEFTERİ").Activate
Cells(2, 1).Select
Do While ActiveCell.Value <> ""
If Trim(ActiveCell.Value) = Trim(Me.TextBox1.Value) Then
If MsgBox(Me.TextBox1 & "  Numaralı Evrak Kaydı Var" & " Yeniden Kayıt Yapılsın mı?", vbYesNo, "Mükerrer Kayıt") = vbNo Then Exit Sub

If TextBox1.Text = "" Or TextBox2.Text = "" Then
MsgBox "İsim veya Sıra No boş geçilemez", vbOKOnly
Else
dene = Application.CountA(Sheets("EVRAK DEFTERİ").Columns("A")) + 1

sira = TextBox1.Text
 
 Sheets("EVRAK DEFTERİ").Cells(dene, 2) = TextBox1.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 3) = TextBox2.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 1) = TextBox3.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 4) = TextBox4.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 5) = TextBox5.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 6) = TextBox6.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 7) = TextBox7.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 8) = TextBox8.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 9) = TextBox9.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 10) = TextBox10.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 11) = TextBox11.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 12) = TextBox12.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 13) = TextBox13.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 14) = TextBox14.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 15) = TextBox15.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 16) = TextBox16.Text
 Sheets("EVRAK DEFTERİ").Cells(dene, 17) = TextBox17.Text
TextBox1.Text = sira + 1
TextBox2.Text = ""
End If
End Sub
 
X

xxrt

Misafir
Sadece merakımdan soruyorum.Bu linkteki sorunuzdaki sorun çözüldümü.
http://www.excel.web.tr/viewtopic.php?p=5402#5402


Bu Soru İçin Dosyanızdaki kodları inceledim.Burada Kayıt Yapması İçin Mutlaka Bir Hücreyi aktif yapması gerekki Ona göre kayıt etsin.Siz Aynı Kayıdı Bulabilmeniz için aramanın yapılması esnasında Yine bir aktif hücre seçecek ve onun yani aktif hücrenin altında arama yapacak.İki Olayı tek kodda yapamazsınız.Ancak TextBox1'in Visible Ã?zelliğini FALSE yapmanız halinde kayıt numaralarına Müdahale edilemiyecektir.

Diğer Bir Konu ise Güncelleme İçin UserForm2'yi çağırmaktansa;UserForm1'in Güncelleme Butonuna aşağıdaki kodları yazmanız gerek.

Kod:
Private Sub CommandButton2_Click()
Set s1 = Sheets("EVRAK DEFTERİ")
noA = WorksheetFunction.CountA(s1.Range("a:a"))
For i = 1 To noA
    If s1.Cells(i, "b") = Val(TextBox1) Then
        s1.Cells(i, "a") = TextBox2.Text
        s1.Cells(i, "c") = TextBox3.Text
        s1.Cells(i, "d") = TextBox4.Text
        s1.Cells(i, "e") = TextBox5.Text
        s1.Cells(i, "f") = TextBox6.Text
        s1.Cells(i, "g") = TextBox7.Text
        s1.Cells(i, "h") = TextBox8.Text
        s1.Cells(i, "ı") = TextBox9.Text
        s1.Cells(i, "j") = TextBox10.Text
        s1.Cells(i, "k") = TextBox11.Text
        s1.Cells(i, "l") = TextBox12.Text
        s1.Cells(i, "m") = TextBox13.Text
        s1.Cells(i, "n") = TextBox14.Text
        s1.Cells(i, "o") = TextBox15.Text
        s1.Cells(i, "p") = TextBox16.Text
        s1.Cells(i, "q") = TextBox17.Text
        MsgBox "Kayıt İşlemi Tamamlandı"
        Exit Sub
    End If
Next i
MsgBox "Aradığınız isimde bir kayıt bulunamadı", vbCritical, "KAYIT"
Sheets("EVRAK DEFTERİ").Select
End Sub
 
Katılım
8 Ekim 2004
Mesajlar
317
Excel Vers. ve Dili
EXCEL 2003 TÜRKÇE
Hocam verdiğiniz fikir için teşekkür ederim. Bu işimi görebilir çalışmalarımı bu yönde değiştirmem gerekecek

Sağlıcakla kalın
 
Üst