hola, perdon por la tardanza, ya que estaba probando codigo, aber, vallamos por partes......
el codigo que me as puesto jose, si copio y pego en la parte del codigo del access da error (me sale en rojo estas lineas)=
Dim re As New Regex("([^A-W0-9]|[OT]|[^\w])", RegexOptions.IgnoreCase)
nif = re.Replace(nif, String.Empty).ToUpper()
re = New Regex("(^[A-HJ-W]\d{7,8}$)|(^[A-HJ-W]\d{7}[A-Z]$)")
If (Not (re.IsMatch(nif))) Then Return Nothing
Dim lastChar As Char = Nothing
Dim digits As String = nif.Substring(1, 7)
For n As Int32 = 0 To digits.Length - 1 Step 2
sumaImpar += CInt(CStr(digits.Chars(n + 1)))
Dim dobleImpar As Int32 = 2 * CInt(CStr(digits.Chars(n)))
sumaPar += (dobleImpar Mod 10) + (dobleImpar \ 10)
Dim sumaTotal As Int32 = sumaPar + sumaImpar
Dim characters() As Char = _
{"J"c, "A"c, "B"c, "C"c, "D"c, "E"c, "F"c, "G"c, "H"c, "I"c}
Dim dc As Char = characters(sumaTotal)
Dim firstChar As Char = nif.Chars(0)
Case "N"c, "P"c, "Q"c, "R"c, "S"c, "W"c, "K"c, "L"c, "M"c
Return characters(sumaTotal)
Case "C"c
If ((lastChar = CStr(sumaTotal)) OrElse (lastChar = dc)) Then
Return lastChar
Return dc
Return CChar(CStr(sumaTotal))
Return Nothing
End Try
por otra parte la informacion de que es el cif la busque en la wiki, y partiendo de eso yo he generado un codigo que me gustaria me ayudarais a terminar o mejorar ya que yo ya tengo la cabeza liada.....
en el formulario de prueba solo tengo un cuadro de texto con la sigiente mascara de entrada....
>L0000000A, luego en el codigo de este tengo esto:
Private Sub cif_KeyPress(KeyAscii As Integer)
Const CarnoValidos = "0123456789IÑOTUXYZ"
Const letrafinal = "KQS"
Const numerofinal = "ABEH"
Const otrasletras = "CDFGJLMNPRVW"
Dim DC As String * 1
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
End If
'MsgBox "variable del DC=" & final
'analizamos el ultimo digito
If 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))
'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
'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
y luego esta otra parte
Private Function CalculoDigitoControl(cif As String) As String
MsgBox "empieza la funcion"
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 "se acabo la funcion"
End Function
lo que no consigo es una vez que se llama a la funcion y calcula ese digito de control es que el el codigo de arriva termine su ejecucion:
1) verificando que este bien introducido el cif ya sea una letra o un numero..... y si no esta que me lo indique......
gracias
