Cálculo del NIF y Verificar NIF y CIF

Fecha: 6/06/2003 (publicado 29/Jun/03)
Autor: SGF
Mail: [email protected]


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 NIF

 Public 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 CIF

 Public 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 Function

Esto es todo, espero que os sirva.


ir al índice

Fichero con el código de ejemplo (4,32 KB)