MÜKERRER KAYDIN ÖNLENMESİ

oerbas · 2 Aralık 2004

MÜKERRER KAYDIN Ã?NLENMESÃ

Aşağıdaki Codu kullanarak Evrak Defteri sayfasına kayıt yapılmaktadır
Evrak defteri B sutununa verilen evrak sayısının aynısı tekrar verilmemesi gerekiyor. Gerçi Bu kod her seferinde yeni bir sayı ürütiyor ama manuel olarak kullanıcı elle bir sayı girdiğinde program bunu kabul ediyor. Kullanıcı hatasını önlemek için aynı sayının tekrar girilmesini engellemek istiyorum. Başka programlarda kullandığım bir kod vardı bu kodun içine ekledim hata verdi yardımcı olabilirmisiniz.

Not : Evrak sayıları B sütununa kopyalanmaktadır.

Kod:

Private Sub CommandButton1_Click()
If TextBox1.Text = "" Or TextBox2.Text = "" Then
'Aynı Evrak sayısının iki kez verilmemesi için

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, 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 = ""
MsgBox "Kayıt İşlemi Tamamlandı Form Temizlenecek"
Unload Me
UserForm1.Show
End If
End Sub

xxrt · 2 Aralık 2004

Bunları Bir deneseniz..TextBoxları tam denemedim.Siz inceleyin.

Kod:

Private Sub CommandButton1_Click()
 Dim bak As Range
    Dim say As Integer
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = TextBox3.Value Then
            MsgBox "Bu Kayıt numarası bulundu."
            Exit Sub
        End If
    Next bak
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(TextBox1.Value, vbUpperCase) = StrConv(TextBox1.Value, vbUpperCase) Then
            MsgBox "Bu Kayıt numarası bulundu."
            Exit Sub
        End If
    Next bak
    
    If TextBox1.Text = "" Or TextBox2.Text = "" Then
'Aynı Evrak sayısının iki kez verilmemesi için

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, 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 = ""
MsgBox "Kayıt İşlemi Tamamlandı Form Temizlenecek"
Unload Me
UserForm1.Show
End If

End Sub

oerbas · 2 Aralık 2004

Hocam aynı numara verilince kayıt yapılması engellendi ama bu seferde yeni kayıt yapamıyorum . Sanırım TextBox3 içinde sınır koydunuz. Ben sadece B sütununun kontrol edilerek TextBox1 deki kayıtların iki kez verilmesini engellemek istemiştim.
sorun bundan kaynaklanıyor olabilirmi

xxrt · 2 Aralık 2004

Bunuda bir deneyin...

Kod:

Private Sub CommandButton1_Click()
Dim bak As Range
    Dim say As Integer
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = TextBox3.Value Then
            MsgBox "Bu Kayıt numarası bulundu."
            Exit Sub
        End If
    Next bak
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox3.Value, vbUpperCase) Then
            MsgBox "Bu isimde bir kaydınız bulundu"
            Exit Sub
        End If
    Next bak
    
    say = WorksheetFunction.CountA(Range("B1:B65000"))
    TextBox1.Value = say
    
    Cells(say + 1, 1).Value = TextBox3.Value
    Cells(say + 1, 2).Value = TextBox1.Value
    
    
    Workbooks("ABONE TAKİP SİSTEMİ 04.XLS").Save
    MsgBox "Verileriniz Kaydedildi", , "KAYIT"
    
    
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000"))
    
End Sub

oerbas · 3 Aralık 2004

Hocam bu kod işe yaradı Sağolasınız.

oerbas · 3 Aralık 2004

Ã?RNEK EVRAK KAYIT PROGRAMI

Hocam EXCEL kitabını farklı kaydedince

Kod:

Workbooks("ABONE TAKİP SİSTEMİ 17.XLS").Save

Bu satırdada değişiklik yapılması gerekiyor. Bu gibi olası durumlarda kullanıcı bunu anlayamayabilir, bu sorun giderilebilirmi [/code]

Açma Parolası :abonetakip
Cod Parolası : omerosman

xxrt · 3 Aralık 2004

Ohhh.Senden çok sevindim...Sayınoerbas, çalışmanız bende var.Bu çalışmaya daha yeni başladınız.Size ben biraz tavsiye veya fikir mahiyetinde birşey söylemek istiyorum.Biliyorum daha önce hazır prolar kullandınızmı?Ama Proğram yapmaya başlamadan önce basamak basamak plan yapmanız gerek.Aklıma ilk gelenler,Veri Kayıt sıra veya kod numaralı,Ã?zlük Bilgiler,Sabitler,Yıllar,Daha sonra hazırladığınız taslağa tüm verileri bunların sayesinde atama yapmayı sağlayın..Mesela Yıl olayı 2005 geçince tüm hücrelerde yılları güncelliyeceksiniz.İsim sicil gibi.....Kısaca bende ilk önce butür başlamıştım,daha sonra işin içinden çıkılmıyor..Veri kayıtlarında kullanacağınız kodları çok iyi seçmelisiniz.Bi ton kayıt kodu var..Kodlar kendi aralarında bayt yönünden az ve çok olarak değişmekte..gibi.gibi.Yanlış anlamayın ben size akıl vermiyorum.Sadece kendi fikrimi,yaşadıklarımdan dolayı yaşacaklara veriyorum...Okey.Birde Userformu Tam ekran yapmışsınız.17 '' ekranda hiç denedinizmi?Bu ve benzeri konular.Çalışmalarınızda başarılar dilerim.

xxrt · 3 Aralık 2004

Kod:

Workbooks("ABONE TAKİP SİSTEMİ 17.XLS").Save

Yerine

Kod:

ActiveWorkbook.Save

Yaz..Ama Userofm büyütmüşsün.Başlığa 3 Düğme ekledim.
UserForm1'in içindeki kodları tamamen sil SİZİN düzenlenen bu kodları yazın..

Kod:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" _
(ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Private Sub UserForm_Activate()
  Dim hWndForm As Long, frmStyle As Long
  hWndForm = FindWindow(vbNullString, Me.Caption)
  frmStyle = GetWindowLong(hWndForm, (-16))
  frmStyle = frmStyle Or &H80000 Or &H20000 Or &H10000
  SetWindowLong hWndForm, (-16), frmStyle
  ShowWindow hWndForm, 5
  DrawMenuBar hWndForm
  TextBox3.Text = Year(Date)
Dim say As Integer
Dim sirasi As String
say = Application.CountA(Sheets("EVRAK DEFTERİ").Columns("A"))
sirasi = "A" & say
TextBox1.Text = Sheets("EVRAK DEFTERİ").Cells(say, 2) + 1
End Sub
Private Sub CBKAYDET_Click()
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
TextBox1.Text = sira + 1
TextBox2.Text = ""
End If
End Sub
Private Sub CommandButton1_Click()
Dim bak As Range
    Dim say As Integer
    For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
        If bak.Value = TextBox3.Value Then
            MsgBox "Bu Kayıt numarası bulundu."
            Exit Sub
        End If
    Next bak
    For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
        If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox3.Value, vbUpperCase) Then
            MsgBox "Bu isimde bir kaydınız bulundu"
            Exit Sub
        End If
    Next bak
    
    say = WorksheetFunction.CountA(Range("B1:B65000"))
    TextBox1.Value = say
    Cells(say + 1, 1).Value = TextBox3.Value
    Cells(say + 1, 2).Value = TextBox1.Value
    Cells(say + 1, 3).Value = TextBox2.Value
    Cells(say + 1, 4).Value = TextBox4.Value
    Cells(say + 1, 5).Value = TextBox5.Value
    Cells(say + 1, 6).Value = TextBox6.Value
    Cells(say + 1, 7).Value = TextBox7.Value
    Cells(say + 1, 8).Value = TextBox8.Value
    Cells(say + 1, 9).Value = TextBox9.Value
    Cells(say + 1, 10).Value = TextBox10.Value
    Cells(say + 1, 11).Value = TextBox11.Value
    Cells(say + 1, 12).Value = TextBox12.Value
    Cells(say + 1, 13).Value = TextBox13.Value
    Cells(say + 1, 14).Value = ComboBox1.Value
    Cells(say + 1, 15).Value = TextBox15.Value
    Cells(say + 1, 16).Value = TextBox16.Value
    Cells(say + 1, 17).Value = TextBox17.Value
    ActiveWorkbook.Save
    MsgBox "Verileriniz Kaydedildi", , "KAYIT"
    TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000"))
    Unload Me
    UserForm1.Show
End Sub
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, "c") = TextBox2.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") = ComboBox1
        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
Private Sub CommandButton3_Click()
'aranan numara yoksa
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
'devam et
Dim x As Integer
x = Sheets("EVRAK DEFTERİ").Range("B:B").Cells.Find(what:=TextBox1, LookIn:=xlValues).Row
TextBox1.Value = TextBox1
TextBox2 = Sheets("EVRAK DEFTERİ").Cells(x, 3)
TextBox3 = Sheets("EVRAK DEFTERİ").Cells(x, 1)
TextBox4 = Sheets("EVRAK DEFTERİ").Cells(x, 4)
TextBox5 = Sheets("EVRAK DEFTERİ").Cells(x, 5)
TextBox6 = Sheets("EVRAK DEFTERİ").Cells(x, 6)
TextBox7 = Sheets("EVRAK DEFTERİ").Cells(x, 7)
TextBox8 = Sheets("EVRAK DEFTERİ").Cells(x, 8)
TextBox9 = Sheets("EVRAK DEFTERİ").Cells(x, 9)
TextBox10 = Sheets("EVRAK DEFTERİ").Cells(x, 10)
TextBox11 = Sheets("EVRAK DEFTERİ").Cells(x, 11)
TextBox12 = Sheets("EVRAK DEFTERİ").Cells(x, 12)
TextBox13 = Sheets("EVRAK DEFTERİ").Cells(x, 13)
ComboBox1 = Sheets("EVRAK DEFTERİ").Cells(x, 14)
TextBox15 = Sheets("EVRAK DEFTERİ").Cells(x, 15)
TextBox16 = Sheets("EVRAK DEFTERİ").Cells(x, 16)
TextBox17 = Sheets("EVRAK DEFTERİ").Cells(x, 17)
CommandButton1.Enabled = True
Exit Sub
    End If
Next i
'Kaydı yoksa kayıt edeyimmi Numarasını yazmadıysa
İkaz = MsgBox("Evrak Numaralı bir kayıt yok." & vbCrLf & "Yeni Kayıt Yapmak İstermisiniz?", vbYesNo + vbExclamation, "Dikkat !")
If ikaz = vbNo Then Cancel = True
TextBox2.SetFocus
Unload Me
If İkaz = vbYes Then UserForm2.Show
'Tamam Düğmesine ait kod son
End Sub
Private Sub ComboBox2_Click()
End Sub
Private Sub CommandButton4_Click()
'aranan numara yoksa
Set s1 = Sheets("EVRAK DEFTERİ")
noA = WorksheetFunction.CountA(s1.Range("a:a"))
For i = 1 To noA
    If s1.Cells(i, "d") = ComboBox2.Text Then
'devam et
Dim x As Integer
x = Sheets("EVRAK DEFTERİ").Range("D:D").Cells.Find(what:=ComboBox2, LookIn:=xlValues).Row
TextBox1 = Sheets("EVRAK DEFTERİ").Cells(i, 2)
TextBox2 = Sheets("EVRAK DEFTERİ").Cells(i, 3)
TextBox3 = Sheets("EVRAK DEFTERİ").Cells(i, 1)
TextBox4 = Sheets("EVRAK DEFTERİ").Cells(i, 4)
TextBox5 = Sheets("EVRAK DEFTERİ").Cells(i, 5)
TextBox6 = Sheets("EVRAK DEFTERİ").Cells(i, 6)
TextBox7 = Sheets("EVRAK DEFTERİ").Cells(i, 7)
TextBox8 = Sheets("EVRAK DEFTERİ").Cells(i, 8)
TextBox9 = Sheets("EVRAK DEFTERİ").Cells(i, 9)
TextBox10 = Sheets("EVRAK DEFTERİ").Cells(i, 10)
TextBox11 = Sheets("EVRAK DEFTERİ").Cells(i, 11)
TextBox12 = Sheets("EVRAK DEFTERİ").Cells(i, 12)
TextBox13 = Sheets("EVRAK DEFTERİ").Cells(i, 13)
ComboBox1 = Sheets("EVRAK DEFTERİ").Cells(i, 14)
TextBox15 = Sheets("EVRAK DEFTERİ").Cells(i, 15)
TextBox16 = Sheets("EVRAK DEFTERİ").Cells(i, 16)
TextBox17 = Sheets("EVRAK DEFTERİ").Cells(i, 17)
CommandButton1.Enabled = True
Exit Sub
End If
Next i
'Kaydı yoksa kayıt edeyimmi Numarasını yazmadıysa
İkaz = MsgBox("Abone İsimli bir kayıt yok." & vbCrLf & "Yeni Kayıt Yapmak İstermisiniz?", vbYesNo + vbExclamation, "Dikkat !")
If ikaz = vbNo Then Cancel = True
TextBox2.SetFocus
Unload Me
If İkaz = vbYes Then UserForm2.Show
'Tamam Düğmesine ait kod son
End Sub
Private Sub ListBox1_Click()
Dim i As Integer
For i = 0 To ListBox1.ListCount - 4
If ListBox1.Selected(i) = True Then
Sheets("EVRAK DEFTERİ").Select
Sheets("EVRAK DEFTERİ").Range("A" & ListBox1.ListIndex + 4).Select
TextBox4.Value = ListBox1.List(i, 0)
TextBox5.Value = ListBox1.List(i, 1)
TextBox6.Value = ListBox1.List(i, 2)
TextBox7.Value = ListBox1.List(i, 3)
TextBox8.Value = ListBox1.List(i, 4)
TextBox9.Value = ListBox1.List(i, 5)
TextBox10.Value = ListBox1.List(i, 6)
TextBox11.Value = ListBox1.List(i, 7)
TextBox12.Value = ListBox1.List(i, 8)
TextBox13.Value = ListBox1.List(i, 9)
End If
Next
End Sub
Private Sub CommandButton5_Click()
Unload Me
End Sub
Private Sub CommandButton6_Click()
If ikaz = vbNo Then Cancel = True
TextBox2.SetFocus
Unload Me
If İkaz = vbYes Then ANA_FORM.Show
ANA_FORM.Show
End Sub
Private Sub CommandButton7_Click()
Unload Me
UserForm1.Show
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(TextBox2.Text) Then
TextBox2.Text = Format(TextBox2.Text, "dd/mm/yyyy")
End If
End Sub
Private Sub TextBox4_Change()
TextBox4 = StrConv(TextBox4, vbUpperCase)
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
With Application
Me.Top = .Top
Me.Left = .Left
Me.Height = .Height
Me.Width = .Width
End With
End Sub

oerbas · 3 Aralık 2004

Hocam bu işe yeni başlayan birisi olarak sizin aklınıza her zaman ihtiyacımız olacak bu yüzden tevazu göstermenize gerek yok. Eksik olmayın sizlerin sayesinde kendi çapımda birşeyler yapmaya çalışıyorum ve mutlu oluyorum.

Ben İSKİ' de memur olarak görev yapmaktayım. Kimi arkadaşlar bilgisayarda oyun oynayarak zaman harcıyor, ben ise bu tür faaliyetlerde bulunarak bundan zevk alıyorum. Eminim sizde benim gibi insanlara yardımcı olmaktan büyük haz duyyorsunuzdur. Verdiğiniz bilgiler ve tavsiyeler için çok teşekkür eder hayırlı çalışmalar dilerim.

xxrt · 3 Aralık 2004

Kimi arkadaşlar bilgisayarda oyun oynayarak zaman harcıyor,

Aynısı burdada var.Ben onlara diyorumki exceli öğrenim..heheh diyorlar...Başlaro sıkıştımı bir tablo bile yaratamıyorlar.Çalışan herzaman kazanır..

benim gibi insanlara yardımcı olmaktan büyük haz duyyorsunuzdur.

Kendimi hasta edecek kadar........Gözlerim çok bozuldu.

oerbas · 3 Aralık 2004

Gözlerinizin bozulduğuna üzüldüm Allah' tan acil şifalar diliyorum. Benimde gözlerimde rahatsızlık var sanırım bu işin sevimsiz olan tarafı gözlere verdiği rahatsızlık.

oerbas · 6 Aralık 2004

Hocam Çok Küçük bir mesele daha var. Ãöyleki Onayla Düğmesi tıklanınca tüm TextBoxlar boş olduğu halde kayıt işlemi gerçekleşiyor. Yanlışlıkla Onayla düğmesi tıklanıldığı zaman da da yeni bir sayı üretip kayıt işlemi gerçekleşiyor.

Ben Sizin yazdığınız Codun üzerine bir ekleme yaptım. Uyarı mesajı veriliyor tamam dediğimizde yine kayıt işlemi devam ediyor. Burada kullanıcı bu mesajı aldıktan sonra kaytıt makrosunun çalşımasın durdurarak kayıt vermesini engelleyebilirmiyiz.

Daha doğrusu Kayıt işlemi için Adı Soyadı ve İlçesi Boş geçilmemesi gerekiyor.

Private Sub CommandButton1_Click()
'TextBoxların boş geçilmemesi için
If TextBox4.Text = "" Or TextBox6.Text = "" Then
MsgBox "İsim veya İlçe boş geçilemez", vbOKOnly
Else
End If
Dim bak As Range
Dim say As Integer
For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
If bak.Value = TextBox3.Value Then
MsgBox "Bu Kayıt numarası bulundu."
Exit Sub
End If
Next bak
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(TextBox3.Value, vbUpperCase) Then
MsgBox "Bu isimde bir kaydınız bulundu"
Exit Sub
End If
Next bak

say = WorksheetFunction.CountA(Range("B1:B65000"))
TextBox1.Value = say

Cells(say + 1, 1).Value = TextBox3.Value
Cells(say + 1, 2).Value = TextBox1.Value
Cells(say + 1, 3).Value = TextBox2.Value
Cells(say + 1, 4).Value = TextBox4.Value
Cells(say + 1, 5).Value = TextBox5.Value
Cells(say + 1, 6).Value = TextBox6.Value
Cells(say + 1, 7).Value = TextBox7.Value
Cells(say + 1, 8).Value = TextBox8.Value
Cells(say + 1, 9).Value = TextBox9.Value
Cells(say + 1, 10).Value = TextBox10.Value
Cells(say + 1, 11).Value = TextBox11.Value
Cells(say + 1, 12).Value = TextBox12.Value
Cells(say + 1, 13).Value = TextBox13.Value
Cells(say + 1, 14).Value = ComboBox1.Value
Cells(say + 1, 15).Value = TextBox15.Value
Cells(say + 1, 16).Value = TextBox16.Value
Cells(say + 1, 17).Value = TextBox17.Value

ActiveWorkbook.Save
MsgBox "Verileriniz Kaydedildi", , "KAYIT"

TextBox1.Value = WorksheetFunction.Count(Range("A1:A65000"))
Unload Me
UserForm1.Show

End Sub

ALPEN · 6 Aralık 2004

'TextBoxların boş geçilmemesi için

Kod:

If TextBox4.Text = "" Or TextBox6.Text = "" Then 
MsgBox "İsim veya İlçe boş geçilemez", vbOKOnly 
Else 
End If

i

Kod:

'TextBoxların boş geçilmemesi için 
If TextBox4.Text = "" Or TextBox6.Text = "" Then 
  MsgBox "İsim veya İlçe boş geçilemez"
  if textbox4 = "" then 
    textbox4.setfocus
  else
    textbox6.setfocus
  end if
exit sub 

End If

olarak değiştirin.

oerbas · 7 Aralık 2004

Hocam eğer çok oldunuz demezseniz bir şey daha sorabilirmiyim. EVRAK KAYIT defteri sıfırlandığı zaman, yanı bütün veriler silip sıfırdan kayıt yapmaya başlanıldığında hata veriyor. Bu sorunu gidermemiz mümkünmüdür.

xxrt · 7 Aralık 2004

EVRAK DEFTERİ sayfanın B2 Hücresi Varsayılan değer olarak 1 kalması gerek.Çünkü bu kod onu arıyor.
Private Sub UserForm_Activate()'de bulunan

Kod:

TextBox1.Text = Sheets("EVRAK DEFTERİ").Cells(say, 2) + 1

oerbas · 8 Aralık 2004

KAYIT GÜNCELLEME

Tüm form çalışanlarına selamlar;

Aşağıdaki Kodu ekrana aldığım kayıtta değişiklik yapmak için kullanıyorum.

Problem: Eğer B sütun bilgileri stok koduna göre çağırma yapılıyor. Bu stok kodları rakam olunca güncelleme yapılıyor ama harf olunca işlem tamamlanmıyor. Verilen sotok kdoları şu şekilde. ( SİST001- EVRG001 Gibi) böyle olunca problem çıkıyor. sorun giderilebilirmi.

Çalışmam çok karışık ama yinede örnek olarak gönderiyorum

Stoklar Formu EKLE/GÜNCELLE Butonuna ait kod

Kod:

Private Sub CommandButton7_Click()
Set s1 = Sheets("stok")
noA = WorksheetFunction.CountA(s1.Range("b:b"))
For i = 1 To noA
    If s1.Cells(i, "b") = Val(TextBox1) Then
        s1.Cells(i, "c") = TextBox2.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
        
        MsgBox "Kayıt İşlemi Tamamlandı"
        Exit Sub
    End If
Next i
MsgBox "Aradığınız Stok Kodlu Bir Kayıt Bulunamadı", vbCritical, "KAYIT"
Sheets("stok").Select
End Sub

werty123 · 12 Ocak 2012

dosya açılmıyor

Skorpiyon · 12 Ocak 2012

2004 yılından kalma bir konuya mesaj yazmışsınız. Forum yanlış hatırlamıyorsam Kasım 2008'de dosya yedeklerini yitirmişti. O yüzden mu dosyaları açmanız mümkün değildir.

Kendi istediğinizi örnek bir dosya ile sorarsanız, yardımcı olacak birileri çıkacaktır.

MÜKERRER KAYDIN ÖNLENMESİ

oerbas

xxrt

Misafir

oerbas

xxrt

Misafir

oerbas

oerbas

xxrt

Misafir

xxrt

Misafir

oerbas

xxrt

Misafir

oerbas

oerbas

ALPEN

oerbas

xxrt

Misafir

oerbas

werty123

Skorpiyon

Misafir