DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
[COLOR="Blue"]Private Sub CommandButton1_Click()
If Len(TextBox1.Text) < 10 Then
MsgBox "10 haneden az değer giremezsiniz.", vbCritical, "UYARI"
Exit Sub
End If
If Not IsNumeric(TextBox1.Text) Then
MsgBox "Lütfen sayısal bir değer giriniz.", vbCritical, "UYARI"
Exit Sub
End If
deg = Array("020", "025", "030", "035")
veri = Mid(TextBox1.Text, 4, 3)
For x = 0 To 3
If deg(x) = veri Then Say = Say + 1
Next
If Say = "" Then
MsgBox "Böyle bir kod tanımlı değil. Kayıt yapılmadı.", vbCritical, "UYARI"
Exit Sub
End If[/COLOR]
If TextBox1.Text > 0 Then
b = Sheets("sayfa1").Range("B65536").End(xlUp).Row
a = b + 1
Sheets("sayfa1").Range("B" & a).Value = _
Application.WorksheetFunction.Max(Sheets("sayfa1").Range("B:B")) + 1
Sheets("sayfa1").Range("B" & a).Value = TextBox1.Text
Sheets("sayfa1").Range("A" & a).Value = Now
[COLOR="blue"]MsgBox "Kayıt yapıldı.", vbInformation, "BAŞARILI"[/COLOR]
Else
MsgBox "ÜRÜN KODUNU GİRİNİZ"
End If
End Sub
Private Sub CommandButton2_Click()
ActiveWorkbook.Save
Application.Quit
End Sub
[COLOR="blue"]Private Sub TextBox1_Change()
If TextBox1 = "" Then Exit Sub
If Len(TextBox1.Text) > 10 Then
MsgBox "10 haneden fazla değer girmezsiniz.", vbCritical, "UYARI"
TextBox1 = Left(TextBox1, 10)
End If
End Sub[/COLOR]
Rica ederim.çok teşekkür ederim