Cálculo del NIF y Verificar NIF y CIF
Fecha: 6/06/2003 (publicado 29/Jun/03)
Autor: SGF
Mail: silviagife@hotmail.com
Aplicación que calcula la letra de un nif (de Guille) y valida NIF y CIF.
Se necesita un formulario con dos cajas y 5 botones (yo los he definido en una matriz de controles, para identificarlos por el índice en vez de por el nombre)
cmdDocum, matriz de controles de los botones, donde:
0 - Calcular Letra NIF
1 - Verificar NIF
2 - Verificar CIF
3 - Limpiar Cajas (opcional)
4 - Salir (opcional)txtDocum, la matriz para las cajas, donde:
0 - Caja de introduccion de datos
1 - Caja donde se muestra los resultados
Calcular NIF
Este código es de Guille, pero lo pongo por si alguien no lo tiene:
Public Function Calc_NIF(valor As String) As String Dim resto As Integer Dim letra_NIF As String letra_NIF = "" If valor = "" Then MsgBox "No se ha introducido datos", , "Aviso" Calc_NIF = "" Exit Function ElseIf Len(valor) < 7 Then MsgBox "No se puede calcular el NIF, faltan dígitos" Calc_NIF = "" Exit Function ElseIf Not IsNumeric(valor) Then MsgBox "el dato introducido no es numérico", , "Aviso" Calc_NIF = "" Exit Function Else resto = Val(valor) Mod 23 Select Case resto Case 0 letra_NIF = "T" Case 1 letra_NIF = "R" Case 2 letra_NIF = "W" Case 3 letra_NIF = "A" Case 4 letra_NIF = "G" Case 5 letra_NIF = "M" Case 6 letra_NIF = "Y" Case 7 letra_NIF = "F" Case 8 letra_NIF = "P" Case 9 letra_NIF = "D" Case 10 letra_NIF = "X" Case 11 letra_NIF = "B" Case 12 letra_NIF = "N" Case 13 letra_NIF = "J" Case 14 letra_NIF = "Z" Case 15 letra_NIF = "S" Case 16 letra_NIF = "Q" Case 17 letra_NIF = "V" Case 18 letra_NIF = "H" Case 19 letra_NIF = "L" Case 20 letra_NIF = "C" Case 21 letra_NIF = "K" Case 22 letra_NIF = "E" End Select Calc_NIF = valor & letra_NIF
Exit Function End If End Function
Código para validar el NIFPublic Function Verificar_NIF(valor As String, mensaje As String) As Boolean Dim aux As String
mensaje = "" valor = UCase(valor) 'ponemos la letra en mayúscula aux = Mid(valor, 1, Len(valor) - 1) 'quitamos la letra del NIF If Len(aux) >= 7 And IsNumeric(aux) Then aux = Calc_NIF(aux) 'calculamos la letra del NIF para comparar con la que tenemos Else MsgBox "El dato introducido no corresponde a un NIF" Verificar_NIF = True Exit Function End If If valor <> aux Then 'comparamos las letras mensaje = "El NIF " & valor & " es INCORRECTO" & vbCrLf & "D.N.I. Correcto: " & aux Verificar_NIF = True Else mensaje ="El NIF " & valor & " es CORRECTO" End If End Function
Código para validar el CIFPublic Function Verificar_CIF(valor As String, mensaje As String) As Boolean Dim strLetra As String, strNumero As String, strDigit As String Dim strDigitAux As String Dim auxNum As Integer Dim i As Integer Dim suma As Integer Dim letras As String letras = "ABCDEFGHKLMPQSX" valor = UCase(valor) If Len(valor) < 9 Or Not IsNumeric(Mid(valor, 2, 7)) Then mensaje = "El dato introducido no corresponde a un CIF" Verificar_CIF = True Exit Function End If strLetra = Mid(valor, 1, 1) 'letra del CIF strNumero = Mid(valor, 2, 7) 'Codigo de Control strDigit = Mid(valor, 9) 'CIF menos primera y ultima posiciones If InStr(letras, strLetra) = 0 Then 'comprobamos la letra del CIF (1ª posicion) mensaje = "la letra introducida no corresponde a un CIF" Verificar_CIF = True Exit Function End If i = 0 For i = 1 To 7 If i Mod 2 = 0 Then suma = suma + CInt(Mid(strNumero, i, 1)) Else auxNum = CInt(Mid(strNumero, i, 1)) * 2 suma = suma + (auxNum \ 10) + (auxNum Mod 10) End If Next suma = (10 - (suma Mod 10)) Mod 10 Select Case strLetra Case "K", "P", "Q", "S" suma = suma + 64 strDigitAux = Chr(suma) Case "X" strDigitAux = Mid(Calc_NIF(strNumero), 8, 1) Case Else strDigitAux = CStr(suma) End Select MsgBox strDigitAux If strDigit = strDigitAux Then mensaje = "CIF correcto" Else mensaje = "El cif no es correcto, el dígito de control no coincide" Verificar_CIF = True End If End FunctionEsto es todo, espero que os sirva.
Fichero con el código de ejemplo (4,32 KB)