Option Compare Database
'Dim DC2 As String
'DC2 = 0
_________________________________________________________
Private Sub cif_BeforeUpdate(Cancel As Integer)
End Sub
__________________________________________________________
Private Sub cif_KeyPress(KeyAscii As Integer)
Const CarnoValidos = "0123456789IÑOTUXYZ"
Const letrafinal = "KQS"
Const numerofinal = "ABEH"
Const otrasletras = "CDFGJLMNPRVW"
Const letras = "ABCDEFGHIJKLMNÑOPQRSTUVWXYZ"
Dim DC As String * 1
'Dim valorfinal As String
Dim numero As String
Dim final As String
'Si estamos en la primera posición y se pulsa una tecla de carácter
If Me.cif.SelStart = 0 And KeyAscii > 31 Then
'Si es uno de los caracteres NO válidos
If Not InStr(1, CarnoValidos, Chr(KeyAscii)) = 0 Then
'Anulamos la pulsación
KeyAscii = 0
MsgBox "Caracter no Valido"
End If
'analizamos que tipo de digito control DC tendra el cif
If Not InStr(1, letrafinal, Chr(KeyAscii)) = 0 Then MsgBox " CIF terminara en letra": final = 1
If Not InStr(1, numerofinal, Chr(KeyAscii)) = 0 Then MsgBox " CIF terminara en numero": final = 0
If Not InStr(1, otrasletras, Chr(KeyAscii)) = 0 Then MsgBox " no sabemos como acabara el CIF": final = 2
MsgBox final
End If
'si es el ultimo caracter, llamamos a la funcion para que nos diga que valor tendra el DC
'If Me.cif.SelStart = 8 And KeyAscii > 48 Or KeyAscii < 90 Then
If Me.cif.SelStart = 8 And KeyAscii > 31 Then
'analizamos el ultimo digito
'If final = 0 And Me.cif.SelStart = 8 And KeyAscii > 48 Or KeyAscii < 57 Then
'Calculamos el digito control por medio de una función
DC = CalculoDigitoControl(Left(Me.cif.Text, 8))
'DC2 = valorfinal
'MsgBox "se mostrara el DC= " & DC2
'DC2 = valorfinal
'MsgBox "mostrare el Digito Control"
'MsgBox DC2
'If DC = Me.cif.SelStart = 8 Then Me.cif.SelStart = 8
End If
'If final = 1 And Me.cif.SelStart = 8 And KeyAscii > 65 Or KeyAscii < 90 Then
'comprobamos si la letra es correcta
'DC = CalculoDigitoControl
'MsgBox "vemos el DC" & DC
'Si la letra no coincide con la que hemos pulsado
' If DC <> UCase(Chr(KeyAscii)) Then
'Anulamos la pulsación
' MsgBox "Letra no valida, deberia ser la " & Letra, vbInformation
' KeyAscii = 0
' End If
' End If
'If Me.cif.SelStart = 0 And KeyAscii = 75 Or KeyAscii = 81 Or KeyAscii = 83 Then
'If final = 0 Then
'If final = 1 Then
'If final = 2 Then
'End If
End Sub
_________________________________________________________________________
Private Function CalculoDigitoControl(cif As String) As String
MsgBox "empieza la funcion"
'Dim DC2 As String
Dim nCIF As Long
Dim nCIFParA As Long
Dim nCIFParB As Long
Dim nCIFParC As Long
Dim nCIFImparA As Long
Dim nCIFImparB As Long
Dim nCIFImparC As Long
Dim nCIFImparD As Long
Dim sumapar As Long
Dim sumaimpar As Long
Dim sumaparcial As Long
Dim valorsumaparcial As Long
Dim valorfinal As Long
Dim mulA As Long
Dim mulB As Long
Dim mulC As Long
Dim mulD As Long
Dim valorA As Long
Dim valorB As Long
Dim sumamulA As Long
Dim valorC As Long
Dim valorD As Long
Dim sumamulB As Long
Dim valorE As Long
Dim valorF As Long
Dim sumamulC As Long
Dim valorG As Long
Dim valorH As Long
Dim sumamulD As Long
'Estas son las letras que corresponden a los 23 restos
Const letras = "ABCDEFGHJKLMNPQRSVW"
'tomamos ejemplo de cif A58818501
'cogemos los digitos desde el 2 hasta el 8
'MsgBox "cogemos los digitos desde el 2 hasta el 8"
' MsgBox Mid(cif, 2, 1)
' MsgBox Mid(cif, 3, 1)
' MsgBox Mid(cif, 4, 1)
' MsgBox Mid(cif, 5, 1)
' MsgBox Mid(cif, 6, 1)
' MsgBox Mid(cif, 7, 1)
' MsgBox Mid(cif, 8, 1)
'Asignamos el valor numérico a los dígitos pares que son segun ejemplo A = 8 B= 1 C= 5
' MsgBox "Asignamos el valor numérico a los dígitos pares"
nCIFParA = Val(Mid(cif, 3, 1))
nCIFParB = Val(Mid(cif, 5, 1))
nCIFParC = Val(Mid(cif, 7, 1))
'MsgBox "numero par 1:" & nCIFParA
'MsgBox "numero par 2:" & nCIFParB
'MsgBox "numero par 3:" & nCIFParC
'sumamos estos valores
'MsgBox "sumamos estos valores"
sumapar = nCIFParA + nCIFParB + nCIFParC
' MsgBox "la suma de los tres numeros pares=" & sumapar
'Asignamos el valor numérico a los dígitos impares que son segun ejemplo A = 5 B= 8 C= 8 D= 0
'MsgBox "Asignamos el valor numérico a los dígitos impares"
nCIFImparA = Val(Mid(cif, 2, 1))
nCIFImparB = Val(Mid(cif, 4, 1))
nCIFImparC = Val(Mid(cif, 6, 1))
nCIFImparD = Val(Mid(cif, 8, 1))
'MsgBox "numero impar 1:" & nCIFImparA
'MsgBox "numero impar 2:" & nCIFImparB
'MsgBox "numero impar 3:" & nCIFImparC
'MsgBox "numero impar 4:" & nCIFImparD
'multiplicamos cada uno de ellos por dos
'MsgBox "multiplicamos cada uno de ellos por dos"
mulA = nCIFImparA * 2
mulB = nCIFImparB * 2
mulC = nCIFImparC * 2
mulD = nCIFImparD * 2
'MsgBox "numero impar 1:" & mulA
'MsgBox "numero impar 2:" & mulB
'MsgBox "numero impar 3:" & mulC
'MsgBox "numero impar 4:" & mulD
'de cada uno de estos resultados de la multiplicacion,extraemos y sumamos sus digitos. supongamos que esto es=11, entonces la suma seria 1+1=2
'MsgBox "de cada uno de estos resultados de la multiplicacion,extraemos y sumamos sus digitos"
valorA = Val(Mid(mulA, 1, 1))
valorB = Val(Mid(mulA, 2, 1))
sumamulA = valorA + valorB
valorB = Val(Mid(mulB, 1, 1))
valorC = Val(Mid(mulB, 2, 1))
sumamulB = valorB + valorC
valorD = Val(Mid(mulC, 1, 1))
valorE = Val(Mid(mulC, 2, 1))
sumamulC = valorD + valorE
valorF = Val(Mid(mulD, 1, 1))
valorG = Val(Mid(mulD, 2, 1))
sumamulD = valorF + valorG
'MsgBox "suma total 1:" & sumamulA & " total 2:" & sumamulB & " total 3:" & sumamulC & " total 4:" & sumamulD
'ahora sumamos la suma de estos digitos....
sumaimpar = sumamulA + sumamulB + sumamulC + sumamulD
'MsgBox "ahora sumamos la suma de estos digitos....que es =" & sumaimpar
'sumamos las dos partes, sumapar y sumaimpar
sumaparcial = sumapar + sumaimpar
'MsgBox "sumamos las dos partes, sumapar y sumaimpar=" & sumaparcial
'ahora cojemos el segundo digito de esta suma
valorsumaparcial = Val(Mid(sumaparcial, 2, 1))
'MsgBox "ahora cojemos el segundo digito de esta suma=" & valorsumaparcial
'ahora esto se lo restamos a 10
valorfinal = 10 - valorsumaparcial
'MsgBox "ahora esto se lo restamos a 10,=" & valorfinal
MsgBox "Valor de la Funcion= " & valorfinal
MsgBox "se acabo la funcion"
'DC2 = valorfinal
'MsgBox "se mostrara el DC= " & DC2
End Function
