Bul Makro Hatası

Katılım
19 Ocak 2005
Mesajlar
940
Excel Vers. ve Dili
İŞ : Microsoft Office Excel 2003
EV : Microsoft Office Excel 2003
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
CommandButton4_Click proseduründe, aşağıdaki satırları orjinali ile değiştirin;


Kod:
'.....
'...
Dim ser As Range
    For Each ser In Range("B4:B" & WorksheetFunction.CountA(Range("B4:B65000")))
        If ListBox1 = ser Then
'....
'...
 
Katılım
19 Ocak 2005
Mesajlar
940
Excel Vers. ve Dili
İŞ : Microsoft Office Excel 2003
EV : Microsoft Office Excel 2003
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Olmaması normal çünkü, prosedurün geri kalan kodları da tamamen yanlış hazırlanmış.

Aşağıdaki şekliyle deneyin;

Kod:
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
 
Katılım
19 Ocak 2005
Mesajlar
940
Excel Vers. ve Dili
İŞ : Microsoft Office Excel 2003
EV : Microsoft Office Excel 2003
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Kod:
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
'.....
'....
'..
 
Katılım
19 Ocak 2005
Mesajlar
940
Excel Vers. ve Dili
İŞ : Microsoft Office Excel 2003
EV : Microsoft Office Excel 2003
Sayın Haluk çok teşekkür ederim.
 
Katılım
19 Ocak 2005
Mesajlar
940
Excel Vers. ve Dili
İŞ : Microsoft Office Excel 2003
EV : Microsoft Office Excel 2003
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
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]
 
Katılım
19 Ocak 2005
Mesajlar
940
Excel Vers. ve Dili
İŞ : Microsoft Office Excel 2003
EV : Microsoft Office Excel 2003
Sayın Haluk deneme yanılma yaptıktan sonra A değerini 2 yaptığımda sorun çözüldü. Tekrar teşekkürler.
 
Katılım
19 Ocak 2005
Mesajlar
940
Excel Vers. ve Dili
İŞ : Microsoft Office Excel 2003
EV : Microsoft Office Excel 2003
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

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
CommandButton1_Click prosedürünü aşağıdaki ile değiştirin;

Kod:
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
 
Üst