Bul Makro Hatası

[ocamsul]

Arkadaşlar ekli PERSONEL isimli sayfamda userform üzerindeki listeden personel ismi seçilip; kayıt görüntüle butonuna basıldığında, hata veriyor yardım edermisiniz?

 

[Haluk]

CommandButton4_Click proseduründe, aşağıdaki satırları orjinali ile değiştirin;

'.....
'...
Dim ser As Range
    For Each ser In Range("B4:B" & WorksheetFunction.CountA(Range("B4:B65000")))
        If ListBox1 = ser Then
'....
'...

 

[ocamsul]

Kodu bu şekilde düzelttim ama olmadı!!!



Private Sub CommandButton4_Click()
Dim ser As Range
For Each ser In Range("B4:B" & WorksheetFunction.CountA(Range("B4:B65000")))
If ListBox1 = ser Then
girdi1.Value = ActiveCell.Offset(0, 1).Value
kutu1.Value = ActiveCell.Offset(0, 2).Value
girdi2.Value = ActiveCell.Offset(0, 3).Value
girdi3.Value = ActiveCell.Offset(0, 4).Value
girdi4.Value = ActiveCell.Offset(0, 5).Value
kutu2.Value = ActiveCell.Offset(0, 6).Value
kutu3.Value = ActiveCell.Offset(0, 7).Value
kutu4.Value = ActiveCell.Offset(0, 8).Value
girdi5.Value = ActiveCell.Offset(0, 9).Value
girdi6.Value = ActiveCell.Offset(0, 10).Value
End Sub

 

[Haluk]

Olmaması normal çünkü, prosedurün geri kalan kodları da tamamen yanlış hazırlanmış.

Aşağıdaki şekliyle deneyin;

Private Sub CommandButton4_Click()
    Dim ser As Range
    For Each ser In Range("B4:B" & WorksheetFunction.CountA(Range("B4:B65000")) + 4)
        ser.Select
        If ListBox1.Value = ser Then
            girdi1.Value = ActiveCell
            kutu1.Value = ActiveCell.Offset(0, 1).Value
            girdi2.Value = ActiveCell.Offset(0, 2).Value
            girdi3.Value = ActiveCell.Offset(0, 3).Value
            girdi4.Value = ActiveCell.Offset(0, 4).Value
            kutu2.Value = ActiveCell.Offset(0, 5).Value
            kutu3.Value = ActiveCell.Offset(0, 6).Value
            kutu4.Value = ActiveCell.Offset(0, 7).Value
            girdi5.Value = ActiveCell.Offset(0, 8).Value
            girdi6.Value = ActiveCell.Offset(0, 9).Value
            Exit Sub
        End If
    Next ser
    MsgBox "Aradığınız isimde bir kayıt bulunamadı Yada Stok Adı Kısmı Şu anda Boş olabilir...", vbInformation
End Sub

 

[ocamsul]

Elinize sağlık çok teşekkür ederim sayın Haluk

belki buraya yazmam doğru değil ama aşağıda koda eğer listede kaydedilmek istenen personel adının aynısı mevcut ise bu kayıt zaten var kayıt yapamazsınız gibi bir mesajla yapılmak istenen kaydın girilmemesini nası engelleyebilirim.

Private Sub CommandButton1_Click()
Sheets("VERİ1").Select
Range("a3").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("A4").Value = "" Then
Range("A4").Value = 1
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
'..........................................................
'Textbox kutularındaki verileri hücrelere yazdırır.
ActiveCell.Offset(0, 1).Value = girdi1.Value
ActiveCell.Offset(0, 2).Value = kutu1.Value
ActiveCell.Offset(0, 3).Value = girdi2.Value
ActiveCell.Offset(0, 4).Value = girdi3.Value
ActiveCell.Offset(0, 5).Value = girdi4.Value
ActiveCell.Offset(0, 6).Value = kutu2.Value
ActiveCell.Offset(0, 7).Value = kutu3.Value
ActiveCell.Offset(0, 8).Value = kutu4.Value
ActiveCell.Offset(0, 9).Value = girdi5.Value
ActiveCell.Offset(0, 10).Value = girdi6.Value
End Sub

 

[Haluk]

Private Sub CommandButton1_Click()
        Sheets("VERİ").Select
        Range("a3").Select
        ActiveCell.Offset(1, 0).Select
        Do While Not IsEmpty(ActiveCell)
        ActiveCell.Offset(1, 0).Select
        If ActiveCell.Offset(0, 1).Text = girdi1.Text Then
        MsgBox "hmmm....!"
        Exit Sub
        End If
        Loop
'.....
'....
'..

 

[ocamsul]

Sayın Haluk çok teşekkür ederim.

 

[ocamsul]

Sevgili Haluk kodu dediğiniz yaptım çalıştı; ancak sizde bi bakarsanız; listeden ilk personel seçilip bilgileri kayıt görüntüle butonu ile görüntülendikten sonra, kaydet denildiğinde aynı kaydı alt satıra yapıyo ikinci defa kaydet butonuna basıldığında ise dediğiniz gibi uyarı mesajı geliyo ve kayıt yapılamıyo. İşte bu noktada bizim ilk tıklamada kaydı engellememiz lazım.

 

[Haluk]

Aşağıdaki ufacık kırmızı değişikliği yapın.

[vb:1:1191165640]Private Sub CommandButton1_Click()
Sheets("VERİ").Select
Range("a2").Select
[/vb:1:1191165640]

 

[ocamsul]

Sayın Haluk deneme yanılma yaptıktan sonra A değerini 2 yaptığımda sorun çözüldü. Tekrar teşekkürler.

 

[ocamsul]

Sayın Haluk ve arkadaşlar. belirtmiş olduğum kriterler aynen kalmak üzere diyelimki bir personelin herhangibir bilgisi değişti bu durumda düzeltme işlemi nasıl yapabilirim?

 

[Haluk]

CommandButton1_Click prosedürünü aşağıdaki ile değiştirin;

Private Sub CommandButton1_Click()
        Dim i As Long, NoB As Long
        Dim MyRng As Range
        Sheets("VERİ").Select
        NoB = Cells(65536, 2).End(xlUp).Row + 1
        For i = 4 To NoB
        If Cells(i, 2) = girdi1.Text Then
            MyQ = MsgBox(girdi1.Text & " daha onceden kayıtlı." & vbCrLf _
                  & " Devam etmek istiyormusunuz?", vbYesNo, "Dikkat !")
                If MyQ = vbNo Then
                    Exit Sub
                Else
                    x = i
                    GoSub WriteData:
                End If
                Exit Sub
        End If
        Next
WriteData:
        If x > 0 Then
            NoB = x
            Cells(NoB, 2).Offset(0, -1) = 1
        Else
            Cells(NoB, 2).Offset(0, -1) = Cells(NoB, 2).Offset(-1, -1) + 1
        End If
        Cells(NoB, 2) = girdi1.Value
        Cells(NoB, 2).Offset(0, 1) = kutu1.Value
        Cells(NoB, 2).Offset(0, 2) = girdi2.Value
        Cells(NoB, 2).Offset(0, 3) = girdi3.Value
        Cells(NoB, 2).Offset(0, 4) = girdi4.Value
        Cells(NoB, 2).Offset(0, 5) = kutu2.Value
        Cells(NoB, 2).Offset(0, 6) = kutu3.Value
        Cells(NoB, 2).Offset(0, 7) = kutu4.Value
        Cells(NoB, 2).Offset(0, 8) = girdi5.Value
        Cells(NoB, 2).Offset(0, 9) = girdi6.Value
End Sub