** NORMAS DEL FORO **
Inicio del foro Inicio del foro > Access y VBA > Tus Funciones Favoritas & Aportaciones & Artí­culos
  Mensajes nuevos Mensajes nuevos RSS - VBA: Verificar el CIF (España)
  Preguntas frecuentes Preguntas frecuentes  Buscar en el foro   Eventos   Registro Registro  Iniciar sesion Iniciar sesion

Tema cerradoVBA: Verificar el CIF (España)

 Responder Responder
Autor
Mensaje
admin Ver desplegable
Administrador
Administrador
Avatar

Unido: 14/Agosto/2013
Localización: Cualquier lugar
Estado: Sin conexión
Puntos: 790
Enlace directo a este mensaje Tema: VBA: Verificar el CIF (España)
    Enviado: 14/Agosto/2013 a las 14:08
Emilio Sancha hacia 2004
Esta función verifica si el código de identificación fiscal (España) es correcto, calculando su digito de control y comparandolo con el pasado

'*******************************************************************************

'* DigitoControlCIF

'* Comprueba la validez del digíto de control del Código de Identificación Fiscal

'* (Español) al tiempo que lo devuelve

'* Argumentos: strCIF => Código de Identificación Fiscal

'* uso: txtDC = DigitoControlCIF(txtCIF)

'* ESH 15/03/04 19:15

'*******************************************************************************

 

 

Public Function DigitoControlCIF(strCIF As String) As String

   

    Dim strTipo As String, _

        strDigitos As String, _

        i As Integer, _

        bytPares As Byte, _

        bytImpares As Byte, _

        strDC As String, _

        strImpares As String

   

    On Error GoTo DigitoControlCIF_TratamientoErrores

   

    If Not IsNumeric(Left(strCIF, 1)) Then

        strTipo = UCase(Left(strCIF, 1))

        strDigitos = Mid(strCIF, 2, 7)

    Else

        strDigitos = Mid(strCIF, 1, 7)

    End If

   

    If Len(strDigitos) <> 7 Then

        MsgBox "El código " & UCase(strCIF) & " no se corresponde con ningún C.I.F.", vbExclamation Or vbSystemModal, "ATENCION"

    End If

   

    ' extraigo el dígito de control, si existe

    If Len(strCIF) = 9 Then strDC = Right(strCIF, 1)

   

    ' sumo los dígitos pares del código

    For i = 2 To 6 Step 2

        bytPares = bytPares + Val(Mid(strDigitos, i, 1))

    Next i

   

    ' calculo la suma de los distintos dígitos del producto de los dígitos impares por 2

    For i = 1 To 7 Step 2

        strImpares = CStr(Val(Mid(strDigitos, i, 1)) * 2)

        If Len(strImpares) = 2 Then

            bytImpares = bytImpares + Val(Left(strImpares, 1)) + Val(Right(strImpares, 1))

        Else

            bytImpares = bytImpares + Val(strImpares)

        End If

    Next i

   

    ' el dígito de control es la diferencia entre 10 y la suma de los distintos dígitos de la suma de pares e impares

    DigitoControlCIF = Right(CStr(10 - Val(Right(bytImpares + bytPares, 1))), 1)

   

    ' compruebo si el digito de control, si existía, es correcto

    If DigitoControlCIF <> strDC Then

        MsgBox "El dígito de control " & UCase(strDC) & " del código " & UCase(strCIF) & " no es correcto", vbExclamation Or vbSystemModal, "ATENCION"

        DigitoControlCIF = ""

    Else

        MsgBox "El dígito de control " & UCase(strDC) & " del código " & UCase(strCIF) & " es correcto", vbExclamation Or vbSystemModal, "ATENCION"

    End If

   

DigitoControlCIF_Salir:

    On Error GoTo 0

    Exit Function

   

DigitoControlCIF_TratamientoErrores:

   

    MsgBox "Error " & Err.Number & " en proc. DigitoControlCIF de Documento VBA Form_Formulario1 (" & Err.Description & ")", vbOKOnly + vbCritical

    GoTo DigitoControlCIF_Salir

   

End Function            ' DigitoControlCIF



Editado por admin - 14/Agosto/2013 a las 14:09
Arriba
 Responder Responder
  Compartir tema   

Ir al foro Permisos de foro Ver desplegable