• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bilgi Girişi Yapmak

Katılım
22 Mayıs 2009
Mesajlar
1,017
Excel Vers. ve Dili
Office 2003
Uzmanlarım;
Ben Formu hazırladım. Sayfayı Hazırladım Elimden Gelende Bu idi. Şimdi sizden yardım istiyorum.
Dosyayı açtığımız zaman gelen forma kaydet dediğimiz zaman
1 - Sıra Numarası verecek
2 - Yazılan Bilgileri Listboxa alacak
3 - Mükerrer kayıda müsade etmeyecek

Yardımcı olabilir misiniz?

Not: 625 kişiyi kopyalayıp yapıştırdığım zaman yukarıdaki işlemi yapabilirse 625 kişiden sonra formdan giriş yapacağım
 

Ekli dosyalar

Selamlar,

Ekteki örnek dosyayı incelermisiniz.

Mükerrer kayıt sorgulaması B sütununa göre ayarlanmıştır.

Uygulanan kodlar;

Kod:
Option Explicit
Dim S1 As Worksheet, SATIR As Long
 
Private Sub CommandButton1_Click()
    If TextBox1 = "" Then
        TextBox1.SetFocus
        MsgBox "Lütfen ADI-SOYADI bilgisiniz giriniz !", vbCritical
        Exit Sub
    End If
 
    If TextBox2 = "" Then
        TextBox2.SetFocus
        MsgBox "Lütfen GSM NO bilgisiniz giriniz !", vbCritical
        Exit Sub
    End If
 
    If TextBox3 = "" Then
        TextBox3.SetFocus
        MsgBox "Lütfen AÇIKLAMA bilgisiniz giriniz !", vbCritical
        Exit Sub
    End If
 
    SATIR = S1.Range("A65536").End(3).Row + 1
 
    If WorksheetFunction.CountIf(S1.Range("B:B"), TextBox1) > 0 Then
        TextBox1.SetFocus
        MsgBox TextBox1 & "   Bu isim daha önce kayıt edilmiştir !" & Chr(10) & "İşleminiz iptal edilmiştir !", vbCritical, "Mükerrer Kayıt !"
        Exit Sub
    End If
 
 
    S1.Cells(SATIR, "A") = SATIR - 1
    S1.Cells(SATIR, "B") = TextBox1
    S1.Cells(SATIR, "C") = TextBox2
    S1.Cells(SATIR, "D") = TextBox3
    TextBox1 = ""
    TextBox2 = ""
    TextBox3 = ""
    TextBox1.SetFocus
 
    With ListBox1
        .ColumnCount = 4
        If S1.Range("A2") = "" Then
        .RowSource = ""
        Else
        .ColumnHeads = True
        .RowSource = S1.Name & "!A2:D" & S1.Range("A65536").End(3).Row
        End If
    End With
 
    MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation
End Sub
 
Private Sub UserForm_Initialize()
    Set S1 = Sheets("Sayfa1")
 
    With ListBox1
        .ColumnCount = 4
        If S1.Range("A2") = "" Then
        .RowSource = ""
        Else
        .ColumnHeads = True
        .RowSource = S1.Name & "!A2:D" & S1.Range("A65536").End(3).Row
        End If
    End With
End Sub
 
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set S1 = Nothing
End Sub
 

Ekli dosyalar

Korhan Abi Eline Emeğine sağlık.

Hakkını Helal et Abi.

Babalar Günün kutlu olsun
 
Geri
Üst