Private Sub CIF_Exit(Cancel As Integer)
'César de Miguel, basado en una aportación de Vicente sobre el CIF en www.aforo.com
Dim a As Integer, b As Integer, c As Integer, D As Integer, e As Integer
Dim NIF As String, TpS As String * 1
Const letras As String = "TRWAGMYFPDXBNJZSQVHLCKET"
NIF = UCase(CIF)
If (Len(NIF) = 8 And IsNumeric(NIF)) Or (Len(NIF) = 9 And Right(NIF, 1) > "A") Then 'Es un carnet de identidad español
a = Left(NIF, 8) Mod 23
TpS = Mid(letras, a + 1)
If TpS <> Right(NIF, 1) Then Msgbox "La letra del control del DNI debiera ser la " & TpS
Else 'Es una sociedad española
If NIF Like "ES-*" Then NIF = Mid(NIF, 4) 'Por si es intertacional de España
If NIF Like "ES*" Then NIF = Mid(NIF, 3) 'Por si es intertacional de España
If Len([NIF]) <> 9 Then
Msgbox "El CIF parece ser incorrecto para una sociedad por no tener 9 dígitos (puede ser un CIF internacional)"
Else
TpS = Left([NIF], 1)
If TpS <> "A" And TpS <> "B" And TpS <> "C" And TpS <> "D" And TpS <> "E" And _
TpS <> "F" And TpS <> "G" And TpS <> "H" And TpS <> "N" And TpS <> "P" And TpS <> "Q" And TpS <> "S" Then
Msgbox "El CIF parece ser incorrecto para una sociedad. La letra no es correcta"
Else
If Abs((Mid([NIF], 2, 1))) > 4 Then a = 1 Else a = 0
If Abs((Mid([NIF], 4, 1))) > 4 Then b = 1 Else b = 0
If Abs((Mid([NIF], 6, 1))) > 4 Then c = 1 Else c = 0
If Abs((Mid([NIF], 8, 1))) > 4 Then D = 1 Else D = 0
e = Abs(((Abs((Mid([NIF], 2, 1))) + Abs((Mid([NIF], 3, 1))) + _
Abs((Mid([NIF], 4, 1))) + Abs((Mid([NIF], 5, 1))) + Abs((Mid([NIF], 6, 1))) + _
Abs((Mid([NIF], 7, 1))) + Abs((Mid([NIF], 8, 1))) + _
Abs((Mid([NIF], 2, 1))) + Abs((Mid([NIF], 4, 1))) + Abs((Mid([NIF], 6, 1))) + _
Abs((Mid([NIF], 8, 1))) + a + b + c + D) Mod 10) - 10)
'Añadido por César al ver algún caso erróneo
Menos10:
If e > 9 Then e = e - 10: GoTo Menos10
'Añadido por César al ver algún caso erróneo
If e <> Abs((Mid([NIF], 9, 1))) Then
Msgbox "El CIF parece ser incorrecto para una sociedad. El dígito final debiera ser un" & [e] & ""
End If
End If
End If
End If
End Sub
---------------------------------------------------------------------
Tu dirección de suscripción a este boletín es esvexp@supercable.es
Para darte de baja, envía un mensaje a
soloaccess-baja-esvexp=supercable.es@eListas.net
Para obtener ayuda, visita http://www.eListas.net/lista/soloaccess
_______________________________________________________________________
Visita nuestro patrocinador:
~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~
Vuela a Estados Unidos, Europa, Asia, Africa...!!!
¡Solo en KLM - Ofertas Especiales!
Para reservar las tarifas más bajas garantizadas...
...haz clic aquí -> http://elistas.net/ml/77/698386698880/tvqfsdbcmf3ft
~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~^~
               (
geocities.com/es/ensolva/Descargas)                   (
geocities.com/es/ensolva)                   (
geocities.com/es)