Private Sub TextBoxCardNr1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim wert As String
Dim CheckNr(1 To 16) As Integer
Dim CheckString As String
Dim CheckPart(1 To 2) As Integer
Dim CheckSum
Dim i, j, k
CheckSum = 0
wert = TextBoxCardNr1.Text
wert = Replace(wert, "-", "")
Me.TextBoxCardNr2.Value = wert
If Me.ComboBoxCardType.Text = "VS" And wert Like "4*" Then
If Len(wert) = 16 Or Len(wert) = 13 Then
GoTo CardValidation
Else
GoTo ErrorMsgCardInvalid
End If
ElseIf Me.ComboBoxCardType.Text = "MA" And wert Like "5*" Then Exit Sub
If Len(wert) = 16 Then
GoTo CardValidation
Else
GoTo ErrorMsgCardInvalid
End If
ElseIf Me.ComboBoxCardType.Text = "AE" And wert Like "3*" Then
If Len(wert) = 15 Then
If wert Like "34##-####-####-###" Or wert Like "37##-####-####-###" Then
GoTo CardValidation
Else
GoTo ErrorMsgCardtypeWrong
End If
Else
GoTo ErrorMsgCardInvalid
End If
ElseIf Me.ComboBoxCardType.Text = "DI" And wert Like "3*" Then
If Len(wert) = 17 Then
If wert Like "300#-####-####-##" _
Or wert Like "301#-####-####-##" _
Or wert Like "302#-####-####-##" _
Or wert Like "303#-####-####-##" _
Or wert Like "304#-####-####-##" _
Or wert Like "305#-####-####-##" _
Or wert Like "36##-####-####-##" _
Or wert Like "38##-####-####-##" Then
GoTo CardValidation
Else
GoTo ErrorMsgCardtypeWrong
End If
Else
GoTo ErrorMsgCardInvalid
End If
ElseIf Not TextBoxCardNr1.Text = "" Then
GoTo ErrorMsgCardtypeWrong
End If
CardValidation:
If Len(wert) Mod 2 = 0 Then 'even lenght numbers (16/14)
For i = 1 To Len(wert) '-------read digits in Cardnumber
CheckNr(i) = VBA.Mid(Me.TextBoxCardNr2.Value, i, 1)
Next i
For j = Len(wert) - 1 To 1 Step -2 '----double alternate digits starting with right - 1
CheckNr(j) = CheckNr(j) * 2
If CheckNr(j) > 8 Then ' if doubled is 2-digit number calculate Sum of digits
CheckString = CheckNr(j)
CheckPart(1) = VBA.Left(CheckString, 1)
CheckPart(2) = VBA.Right(CheckString, 1)
CheckNr(j) = CheckPart(1) + CheckPart(2)
End If
Next j
'------add all CheckNr's to make CheckSum
For k = 1 To Len(wert)
CheckSum = CheckSum + CheckNr(k)
Next k
'------check that Checksum / 10 does not leave remainder - if so CardNr is invalid
If Not CheckSum Mod 10 = 0 Then
GoTo ErrorMsgCardInvalid
Else
Me.TextBoxCardNr2.SelStart = 0
Me.TextBoxCardNr2.SelLength = Len(wert)
TextBoxCardNr2.Copy
Me.TextBoxCardSecCode.SetFocus
Exit Sub
End If
Else 'oddlenght numbers (13/15)
For i = 1 To Len(wert) '-------read digits in Cardnumber
CheckNr(i) = VBA.Mid(Me.TextBoxCardNr2.Value, i, 1)
Next i
For j = Len(wert) - 1 To 2 Step -2 '----double alternate digits starting with right - 1
CheckNr(j) = CheckNr(j) * 2
If CheckNr(j) > 8 Then ' if doubled is 2-digit number calculate Sum of digits
CheckString = CheckNr(j)
CheckPart(1) = VBA.Left(CheckString, 1)
CheckPart(2) = VBA.Right(CheckString, 1)
CheckNr(j) = CheckPart(1) + CheckPart(2)
End If
Next j
'------add all CheckNr's to make CheckSum
For k = 1 To Len(wert)
CheckSum = CheckSum + CheckNr(k)
Next k
'------check that Checksum / 10 does not leave remainder - if so CardNr is invalid
If Not CheckSum Mod 10 = 0 Then
GoTo ErrorMsgCardInvalid
Else
Me.TextBoxCardNr2.SelStart = 0
Me.TextBoxCardNr2.SelLength = Len(wert)
TextBoxCardNr2.Copy
Me.TextBoxCardSecCode.SetFocus
Exit Sub
End If
End If
Exit Sub
ErrorMsgCardtypeWrong:
MsgBox "Esta tarjeta no puede ser de tipo " & Me.ComboBoxCardType.Text & "." & vbCr & _
"Por favor examinar tipo y numero." & vbCr & vbCr & _
"Si el numero empieza" & vbCr & _
"con 3 puede ser AmEx (AE)o Diners (DI)," & vbCr & _
"con 4 es Visa (VS)" & vbCr & _
"con 5 es MasterCard (MA).", vbOKOnly Or vbExclamation
Exit Sub
ErrorMsgCardInvalid:
MsgBox "Numero ingresado no es valido." & vbCr & vbCr & _
"Por favor examinar el numero.", vbOKOnly Or vbExclamation
End Sub