Tengo problemas con cálculo de NIF/NIE
Hace un tiempo NEKKITO NCK dió una solución muy buena para el cálculo con de la letra del NIF, para ACCESS con VB, pero aunque decía que servía también para el cálculo de NIE, hay algún fallo
Esté fué el serial que puso en mayo del 2.013
RESPUESTA DE NECKKITO NCK
Neckkito Nck, Access... Ser o no ser. Esa es la cuestión
Hola!
Voy a suponer que escribes el DNI en el campo [txtDNI], que es coincidente con el campo que te guarda el DNI con la letra.
En tu formulario, en ese campo donde escribes el DNI, sacas sus propiedades y te vas a la pestaña Eventos -> Después de actualizar, y le generas el siguiente código:
...
Private Sub...
Dim elNIF As String
Dim primerCaracter As String
'Cogemos el valor introducido pasándolo a mayúsculas
elNIF = UCase(Me.txtDni.Value)
'Obtenemos el primer carácter
primerCaracter = Left(elNIF, 1)
'Miramos el primer carácter
Select Case primerCaracter
Case "X" 'El carácter es una X
'Cogemos los valores numéricos
elNIF = CStr(Right(elNIF, Len(elNIF) - 1))
'Sacamos la letra
elNIF = "X" & NIF(Val(elNIF))
Case "Y" 'El carácter es una Y
'Sustituimos la Y por un 1
elNIF = "1" & CStr(Right(elNIF, Len(elNIF) - 1))
'Sacamos la letra
elNIF = "Y" & NIF(Val(elNIF))
Case "Z" 'El carácter es una Z
'Sustituimos la Z por un 2
elNIF = "2" & CStr(Right(elNIF, Len(elNIF) - 1))
'Sacamos la letra
elNIF = "Z" & NIF(Val(elNIF))
Case Else
'Es un DNI no extranjero
elNIF = NIF(Val(elNIF))
End Select
'Escribimos el valor obtenido en el campo txtDNI
Me.txtDni.Value = elNIF
End Sub
...
Para escribir ese código se te habrá abierto el editor de VB en el módulo asociado en el formulario. Entonces ahí, bajo la primera línea que te aparece (Option Explicit), escribes la siguiente función:
...
Private Function NIF(DNI As Long)
NIF = DNI & Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (DNI Mod 23) + 1, 1)
End Function
Yo he detectado que si pones un número de NIE que empiece por X no hay problema, el resultado es correcto, pero si empieza por Y entre la Y y el primer número se pone también aparece un 1, y si empieza por Z entre la Z y el primer número se pone también aparece un 2, (p.e. El número X1162138, el resultado es X1162138V; si fuese Y1162138, el resultado correcto es Y1162138P sin embargo sale Y11162138P; si fuese Z1162138, el resultado correcto es Z1162138E sin embargo sale Z21162138E), esto nos indica que algo tiene que tener mar el serial.
Podría contestar alguien, si fuera Neckkito mejor,
Muchas gracias.
1 Respuesta
No soy Neckkito, pero colaboro en su web ocasionalemte y creo que te puedo solucionar el problema: mira el ejemplo que colgué (Comprobar CIF's y números de cuenta)
En el módulo tienes las funciones CompruebaNIF, DigitoNIF, DigitoCIF, que tendrás que copiar, y luego en tu cuadro de texto (imaginemos que se llama NIF), en el evento despues de actualizar le pones simplemente:
Private Sub NIF_AfterUpdate()
Dim DNI As String 'Declaramos la variable
DNI = Ucase(Me.CIF.Value) 'Recogemos el valor introducido en esa variable Me.NIF.Value = CompruebaNIF(DNI) 'Asignamos el valor igualándolo a la llamada a la función, pasándole
'como argumento nuestra variable
End sub
Llego al enlace (Comprobar CIF's y números de cuenta), pero cuando voy ha abrir cualquiera de los dos archivos (el pdf, o BD) me dice "Esta página Web no está disponible".
Soy "novel" en ACCESS, ruego a quien me conteste me indique lo que tengo que hacer paso a paso.
Muchas gracias
Pega este código en un módulo nuevo:
'--------------------------------------------------------------------------------------------
'Función que comprueba y corrige, en su caso, el NIF
'--------------------------------------------------------------------------------------------
Public Function CompruebaNIF(ByVal CIFNIF As String) As String
'Comprobamos el tamaño del NIF
If Len(CIFNIF) <> 9 Then
MsgBox "El NIF debe tener 9 caracteres.", vbOKOnly + vbCritical, "ATENCIÓN"
Exit Function
End If
Select Case Mid$(CIFNIF, 1, 1)
Case 0 To 9 ' Es un DNI
CompruebaNIF = DigitoNIF(CLng(Val(CIFNIF)))
Case "X", "Y", "Z" ' Es un NIE
CompruebaNIF = DigitoNIF(CLng(Val(CIFNIF)))
Case "A" To "K", "L" To "N", "P", "Q", "S"
CompruebaNIF = DigitoCIF(CIFNIF)
Case Else
MsgBox "La Primera letra no corresponde a un CIF.", vbOKOnly + vbCritical, "ATENCIÓN"
End Select
If Right(CIFNIF, 1) = CompruebaNIF Then
CompruebaNIF = CIFNIF
Else
CompruebaNIF = Left(CIFNIF, Len(CIFNIF) - 1) & CompruebaNIF
End If
End Function
'--------------------------------------------------------------------------------------------
'Función que determina la letra del DNI
'--------------------------------------------------------------------------------------------
Public Function DigitoNIF(ByVal DNI As Long) As String
Select Case Left$(DNI, 1) 'Orden EHA/451/2008, de 20 de febrero
Case Is = "X"
DigitoNIF = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(Replace(DNI, "X", "0")) Mod 23) + 1, 1)
Case Is = "Y"
DigitoNIF = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(Replace(DNI, "Y", "1")) Mod 23) + 1, 1)
Case Is = "Z"
DigitoNIF = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(Replace(DNI, "Z", "2")) Mod 23) + 1, 1)
Case Else
DigitoNIF = Mid$("TRWAGMYFPDXBNJZSQVHLCKE", (Val(DNI) Mod 23) + 1, 1)
End Select
End Function
'--------------------------------------------------------------------------------------------
'Función que determina el dígito de control de un CIF
'--------------------------------------------------------------------------------------------
Public Function DigitoCIF(ByVal CIF As String) As String
Dim A As Integer, B As Integer, C As Integer, i As Integer
Dim temp As String
Dim CIFDigito As String
A = 0
B = 0
temp = Mid(CIF, 2, 7) 'Se obtienen los dígitos centrales
CIFDigito = Right(CIF, 1) 'Dígito de control
For i = 1 To 6 Step 2
A = A + Mid(temp, i + 1, 1) 'Suma de posiciones pares
C = 2 * Mid(temp, i, 1) 'Doble de posiciones impares
B = B + (C Mod 10) + Int(C / 10) 'Suma de digitos de doble de pares
Next i
'Para obtener el cálculo de la cifra de la séptima posición que no se trata en el bucle
B = B + ((2 * Mid(temp, 7, 1)) Mod 10) + Int((2 * Mid(temp, 7, 1)) / 10)
'Se obtiene la unidad de la cifra total
C = (10 - ((A + B) Mod 10)) Mod 10
Dim Digito As String
Dim Letras As Variant
Letras = Array("J", "A", "B", "C", "D", "E", "F", "G", "H", "I")
Select Case (Left(CIF, 1))
'Los CIF que comienzan por estas letras deben terminar en una letra de la lista anterior
Case "K", "P", "R", "Q", "S", "W"
DigitoCIF = Letras(C)
'Los CIF que comienzan por estas letras deben terminar en un dígito
Case "A", "B", "E", "H", "J", "U", "V"
DigitoCIF = C
'Para el resto de CIF, la terminación puede ser un número o una letra
Case Else
If IsNumeric(CIFDigito) Then
DigitoCIF = C
Else
DigitoCIF = Letras(C)
End If
End Select
End Function
Que son las 3 funciones que te comentaba. Luego, en el evento después de actualizar de tu campo, pones el código como te indicaba antes.
De todos modos, decirte que el enlace sí funciona y sí deja descargar los archivos.
