Problemas con una función en access 2003
hola, en mi intento de poder conseguir algo que funcione con el cif, intento llamar a una función que copie en la wiki, ni se llamarla ni se utilizarla.....
os comento lo que quiero, mediante un cuadro de texto con la mascara >L0000000A introduzco el dato del cif, lo que quiero es que cuando introduzca el cif, la función compruebe si es correcto o no, si no lo es, que me advierta de ello (supongo que con el dígito de control)
pues este es el código, repito, la función es copiada de la wiki.....
Option Compare Database
Private Sub CIF_BeforeUpdate(Cancel As Integer)
End Sub
'Valida que un cif introducido sea correcto
'según la Orden EHA/451/2008
Public Function Valida_CIF(ByVal valor As String) As Boolean
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim cif As String
Dim CIFDIGITO As String
Dim i As Integer
A = 0
B = 0
Valida_CIF = False
If Len(valor) <> 9 Then 'el CIF debe tener 9 cifras
Exit Function
End If
cif = Mid(valor, 2, 7) 'se obtienen los dígitos centrales
CIFDIGITO = Right(valor, 1) 'dígito de control
For i = 1 To 6 Step 2
A = A + Mid(cif, i + 1, 1) 'Suma de posiciones pares
C = 2 * Mid(cif, i, 1) 'Doble de posiciones impares
B = B + (C Mod 10) + Int(C / 10) 'Suma de dígitos 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(cif, 7, 1)) Mod 10) + Int((2 * Mid(cif, 7, 1)) / 10)
'se obtiene la unidad de la cifra total
C = (10 - ((A + B) Mod 10)) Mod 10
Dim Dígito As String
Dim letras As Variant
letras = Array("J", "A", "B", "C", "D", "E", "F", "G", "H", "I")
Select Case (Left(valor, 1))
'los cif que comienzan por estas letras deben terminar en una letra
'concreta de la lista anterior
Case "QUE", "P", "R", "QUE", "ES", "W": Dígito = letras(C)
'los cif que comienzan por estas letras deben terminar en un dígito
Case "A", "B", "E", "H", "J", "U", "V": Dígito = C
Case "POR", "Y", "Z":
' Error: es un NIE
'para el resto de cif, la terminación puede ser un número o una letra
Case Else
If IsNumeric(CIFDIGITO) Then
Dígito = C
Else
Dígito = letras(C)
End If
End Select
Valida_CIF = (CIFDIGITO = Dígito)
End Function
gracias
