End Sub Hatasında Yardım

fatih34 · 31 Mart 2013

Hocalarım çalışmama aşağıda verdiğim kaydet kodunu uyguladım. Ancak end sub hatası verdi.
Ind If ekledim ancak kayıt yapmadı. Acaba nerede hata yaptım.

Private Sub CommandButton1_Click() 'KAYDET TUŞU (Yeni veri girişi için kullanılmaktadır.)
Sheets("Sayfa1").Select
Satır = Range("T65536").End(3).Row + 1
'1 - Doğru veri tabanı oluşturmak için kullanıcının tüm verileri girmesi gerekmektedir.
'Aşağıdaki sorgularla personele ait tüm bilgilerin girilmesini zorunlu kılıyoruz.

If TextBox1.Text = "" Then
TextBox1.SetFocus
Exit Sub
End If
If TextBox2.Text = "" Then
TextBox2.SetFocus
Exit Sub
End If
If TextBox3.Text = "" Then
TextBox3.SetFocus
Exit Sub
End If
If TextBox4.Text = "" Then
TextBox4.SetFocus
Exit Sub
End If
If TextBox5.Text = "" Then
TextBox5.SetFocus
Exit Sub
End If
If TextBox6.Text = "" Then
TextBox6.SetFocus
Exit Sub
End If
If TextBox7.Text = "" Then
TextBox7.SetFocus
Exit Sub
End If
If ComboBox1.Text = "" Then
ComboBox1.SetFocus
Exit Sub
If TextBox17.Text = "" Then
TextBox17.SetFocus
Exit Sub
End If
If TextBox11.Text = "" Then
TextBox11.SetFocus
Exit Sub
End If
If TextBox12.Text = "" Then
TextBox12.SetFocus
Exit Sub
End If
If TextBox10.Text = "" Then
TextBox10.SetFocus
Exit Sub
End If
If ComboBox2.Text = "" Then
ComboBox2.SetFocus
Exit Sub
End If
If ComboBox3 = "" Then
ComboBox3.SetFocus
Exit Sub
End If

'3 - Kayıt işlemi için gerekli bilgileri ilgili hücrelere aktarıyoruz.
Cells(Satır, "T") = Cells(Satır - 1, "T") + 1
Cells(Satır, "B") = TextBox1.Text
Cells(Satır, "D") = TextBox2.Text
Cells(Satır, "C") = TextBox3.Text
Cells(Satır, "E") = TextBox4.Text
Cells(Satır, "G") = TextBox5.Text
Cells(Satır, "Y") = TextBox6.Text
Cells(Satır, "Z") = TextBox7.Text
Cells(Satır, "AA") = TextBox8.Text
Cells(Satır, "AD") = ComboBox1.Text
Cells(Satır, "AC") = TextBox11.Text
Cells(Satır, "H") = TextBox11.Text
Cells(Satır, "I") = TextBox12.Text
Cells(Satır, "V") = TextBox10.Text
Cells(Satır, "J") = ComboBox2.Text
Cells(Satır, "W") = ComboBox3.Text
TextBox14.Text = Cells(Satır - 1, "T")
MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"
End Sub

mancubus · 31 Mart 2013

Kod:

    If ComboBox1.Text = "" Then
       ComboBox1.SetFocus
    Exit Sub
    [B][COLOR="Red"]End If[/COLOR][/B]

mancubus · 31 Mart 2013

eğer tüm textbox'lar ve combobox'ların boş geçilmemesi isteniyorsa, bütün o kodların yerine aşağıdaki yeterli olur.

Kod:

Dim Ctrl As Control

For Each Ctrl In Me.Controls
    If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then
        If Ctrl.Text = vbNullString Then
            Ctrl.SetFocus
            Exit Sub
        End If
    End If
Next

not: foruma kod eklerken yapıştırma işleminden sonra kodun tamamını seçerek cevaplama panelindeki # butonuna tıklayınız. benim mesajlarımda olduğu gibi görünmesini sağlar.

fatih34 · 31 Mart 2013

Teşekkür ederim Hocam. O zaman kodu nasıl değiştireceğim. Bu kodu bir çalışma da örnek bulup kendi çalışmama uygulamıştım

mancubus · 1 Nisan 2013

bir işe yaramadığı görülen ve aşağıdaki kodları bozan şu satırı çıkardım. hücrelere kayıt işlemi için kullanılan bir userform'da özel bir amacı yoksa hücreden TextBox'a veri almanın da bir gereği yoktur.

TextBox14.Text = Cells(Satır - 1, "T")

eğer bir işe yarıyorsa izah edin ona göre yeniden düzenleyelim.

kodlar:

Kod:

Private Sub CommandButton1_Click() 'KAYDET TUŞU (Yeni veri girişi için kullanılmaktadır.)

    Dim Ctrl As Control
    Dim Satır As Long
    
    '1 - Doğru veri tabanı oluşturmak için kullanıcının tüm verileri girmesi gerekmektedir.
    'Aşağıdaki döngü ile personele ait tüm bilgilerin girilmesini zorunlu kılıyoruz.
    
    For Each Ctrl In Me.Controls
        If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then
            If Ctrl.Text = vbNullString Then
                Ctrl.SetFocus
                Exit Sub
            End If
        End If
    Next
    
    '3 - Kayıt işlemi için gerekli bilgileri ilgili hücrelere aktarıyoruz.
    With Worksheets("Sayfa1")
        Satır = .Range("T65536").End(3).Row + 1
        .Cells(Satır, "T") = .Cells(Satır - 1, "T") + 1
        .Cells(Satır, "B") = TextBox1.Text
        .Cells(Satır, "D") = TextBox2.Text
        .Cells(Satır, "C") = TextBox3.Text
        .Cells(Satır, "E") = TextBox4.Text
        .Cells(Satır, "G") = TextBox5.Text
        .Cells(Satır, "Y") = TextBox6.Text
        .Cells(Satır, "Z") = TextBox7.Text
        .Cells(Satır, "AA") = TextBox8.Text
        .Cells(Satır, "V") = TextBox10.Text
        .Cells(Satır, "AC") = TextBox11.Text
        .Cells(Satır, "H") = TextBox11.Text
        .Cells(Satır, "I") = TextBox12.Text
        .Cells(Satır, "AD") = ComboBox1.Text
        .Cells(Satır, "J") = ComboBox2.Text
        .Cells(Satır, "W") = ComboBox3.Text
    End With
    
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"

End Sub

fatih34 · 1 Nisan 2013

sayın hocam ilginizden dolayı teşekkür ederim. Emeğinize ve bilginize sağlık. İş yerinde personelle alakalı gelen şikayetleri kayıt altına alıp takip etmek için bir çalışma hazırlamaya çalışıyorum.
TextBox14'de en son yapılan kaydı görüp gelen evrakın üzerine yazıyorum.

Bunla alakalı bir yer de takıldım hocam onla alakalı da formda otomatik sayı verme konusu olarak yardım talebinde bulundum. Otomatik sayıyı T sütununa verdiriyorum. (Esas No) olarak. Sırayı 1,2,3 değilde 2013/01,2013/02 diye verdirip Texbox14'e nasıl uygulaya bilirim.

mancubus · 1 Nisan 2013

aşağıdaki gibi olabilir.
A sütunundaki formüller silinmeli. kaydet butonu burayı da her yeni kayıtta 1 adet arttıracak.

Kod:

Private Sub UserForm_Initialize()

    Dim X1 As Long, Y1 As Long, Y2 As Long, X2 As Long
    Dim CX As Double, CY As Double
    Dim MyCtrl As Control
    
    X1 = Application.Width
    Y1 = Application.Height
    X2 = Me.Width
    Y2 = Me.Height
    CX = X1 / X2
    CY = Y1 / Y2
    Me.Width = X1
    Me.Height = Y1
    
    For Each MyCtrl In Me.Controls
        MyCtrl.Top = MyCtrl.Top * CY
        MyCtrl.Left = MyCtrl.Left * CX
        MyCtrl.Width = MyCtrl.Width * CX
        MyCtrl.Height = MyCtrl.Height * CY
        On Error Resume Next
        MyCtrl.Font.Size = MyCtrl.Font.Size * CY
        On Error GoTo 0
    Next
    
    Satır = Worksheets("Sayfa1").Range("T65536").End(3).Row + 1
    TextBox18 = Replace(Worksheets("Sayfa1").Range("AR2"), ".", ",")
    TextBox14.Text = TextBox18.Text & "/" & Format(Satır - 1, "000")
    ComboBox1.RowSource = "Sayfa2!J5:J20"
    ComboBox2.RowSource = "Sayfa2!A6:A50"
    ComboBox3.RowSource = "Sayfa2!H6:H6500"

End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)

    If TextBox3.Value <> "" And IsDate(TextBox3.Value) = False Then
        MsgBox ("hatalı veri girişi" & vbCrLf & TextBox3)
        TextBox3.Value = ""
    Else
        TextBox3 = Format(TextBox3, "dd.mm.yyyy")
    End If

End Sub

Private Sub TextBox8_Exit(ByVal Cancel As MSForms.ReturnBoolean) 'bu TextBox ta tarih görünüyor.

    If TextBox8.Value <> "" And IsDate(TextBox8.Value) = False Then
        MsgBox ("hatalı veri girişi" & vbCrLf & TextBox8)
        TextBox8.Value = ""
    Else
        TextBox8 = Format(TextBox8, "dd.mm.yyyy")
    End If

End Sub

Private Sub CommandButton1_Click() 'KAYDET TUŞU (Yeni veri girişi için kullanılmaktadır.)

    Dim Ctrl As Control
    Dim Satır As Long
    
    '1 - Doğru veri tabanı oluşturmak için kullanıcının tüm verileri girmesi gerekmektedir.
    'Aşağıdaki döngü ile personele ait tüm bilgilerin girilmesini zorunlu kılıyoruz.
    
    For Each Ctrl In Me.Controls
        If TypeName(Ctrl) = "TextBox" Or TypeName(Ctrl) = "ComboBox" Then
            If Ctrl.Text = vbNullString Then
                Ctrl.SetFocus
                Exit Sub
            End If
        End If
    Next

'3 - Kayıt işlemi için gerekli bilgileri ilgili hücrelere aktarıyoruz.
    With Worksheets("Sayfa1")
        Satır = .Range("T65536").End(3).Row + 1
        .Cells(Satır, "A") = Application.Max(.Range("A2:A" & Satır)) + 1
        .Cells(Satır, "T") = TextBox14.Text
        .Cells(Satır, "B") = TextBox1.Text
        .Cells(Satır, "D") = TextBox2.Text
        .Cells(Satır, "C") = TextBox3.Text
        .Cells(Satır, "E") = TextBox4.Text
        .Cells(Satır, "G") = TextBox5.Text
        .Cells(Satır, "Y") = TextBox6.Text
        .Cells(Satır, "Z") = TextBox7.Text
        .Cells(Satır, "AA") = TextBox8.Text
        .Cells(Satır, "AD") = ComboBox1.Text
        .Cells(Satır, "AC") = TextBox17.Text
        .Cells(Satır, "H") = TextBox11.Text
        .Cells(Satır, "I") = TextBox12.Text
        .Cells(Satır, "V") = TextBox10.Text
        .Cells(Satır, "J") = ComboBox2.Text
        .Cells(Satır, "W") = ComboBox3.Text
    End With

    ThisWorkbook.Save 'her kayıt sonrası dosyayı kaydeder.
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Kayıt İşlemi"
    Unload Me
    UserForm2.Show

End Sub

Private Sub CommandButton2_Click()
    Unload Me
End Sub

fatih34 · 2 Nisan 2013

Hocam teşekkür ederim.Ancak veri girişi yaptığımda 2013/001'i ilgili hücreye atıyor ancak textbox14'de 2013/002 olarak gösteriyor.İlgili hücredeki sayıdan 1 fazla gösteriyor.

mancubus · 2 Nisan 2013

UserForm_Initialize olayındaki satır değişkeni:

Kod:

Satır = Worksheets("Sayfa1").Range("T65536").End(3).Row + 1

aşağıdaki şekilde, yani sonundaki "+1"i silerek düzeltin:

Kod:

Satır = Worksheets("Sayfa1").Range("T65536").End(3).Row

fatih34 · 4 Nisan 2013

Teşekkür ederim Hocam

End Sub Hatasında Yardım

fatih34

mancubus

Destek Ekibi

mancubus

Destek Ekibi

fatih34

mancubus

Destek Ekibi

fatih34

Ekli dosyalar

mancubus

Destek Ekibi

fatih34

mancubus

Destek Ekibi

fatih34