Pues es una aplicación que sirve para validar el nif (esta parte es de guille) y una parte para validar el cif.

No esta muy probada y el código no es una maravilla, por lo que si alguien detecta algún fallo me gustaría que me lo dijera.

A parte de esto solo se necesitan dos botones y dos cajas de texto en un formulario estándar y ponerles estos nombre:

cmdNIF -> al boton para calcular el NIF

cmdCIF -> al boton para calcular el CIF

txtCorrecto_Control -> caja de texto donde salen las validaciones correctas o incorrectas

txtNIF_CIF.Text -> caja de texto donde se introducen los datos a validar tanto el CIF como el NIF

Private Sub cmdNIF_Click()

Const cNUMEROS = "0123456789"

Dim aux As String

For i = 1 To Len(txtNIF_CIF) - 1

If InStr(cNUMEROS, Mid$(txtNIF_CIF.Text, i, 1)) Then

aux = aux + Mid$(txtNIF_CIF.Text, i, 1)

End If

Next

txtCorrecto_Control = CalculaNIF(UCase(Trim(aux)))

If UCase(Trim(txtNIF_CIF.Text)) = UCase(Trim(txtCorrecto_Control)) Then

MsgBox "CORRECTO"

End If

If UCase(Trim(txtNIF_CIF.Text)) <> UCase(Trim(txtCorrecto_Control)) Then

MsgBox "INCORRECTO"

End If

End Sub

Private Function CalculaNIF(strA As String) As String

Const cCADENA = "TRWAGMYFPDXBNJZSQVHLCKE"

'Const cNUMEROS = "0123456789"

Dim strT As String, strB As String

Dim a#, NIF#, b#, c#

Dim i As Integer

strT = Trim$(strA)

If Len(strT) = 0 Then Exit Function

'strB = ""

'For i = 1 To Len(strA)

' If InStr(cNUMEROS, Mid$(strA, i, 1)) Then

' strB = strB + Mid$(strA, i, 1)

' End If

'Next

'strA = strB

a# = 0

NIF# = Val(strA)

Do

b# = Int(NIF# / 24)

c# = NIF# - (24 * b#)

a# = a# + c#

NIF# = b#

Loop While b# <> 0

b# = Int(a# / 23)

c# = a# - (23 * b#)

strA = Trim$(strT) + Mid$(cCADENA, c# + 1, 1)

CalculaNIF = strA

End Function

Private Function CalculaCIF(strA As String) As String

Dim strB, strC, strD, aux, ncaux, ncaux2, ncaux3 As String

Dim i, i2, i3, auxim As Integer

Dim a#, b#, c#, d#

Dim d1#, d2#

Dim aimpar(4) As String

If Len(strA) = 0 Or Len(strA) < 9 Then Exit Function

strB = Mid(strA, 1, 1)

strC = Mid(strA, 9, 1)

strD = Mid(strA, 2, 7)

For i = 2 To Len(strD)

a# = a# + Int(Mid(strD, i, 1))

i = i + 1

Next i

i = 0

i2 = 0

For i = 1 To Len(strD)

b# = (Int(Mid(strD, i, 1)) * 2)

aimpar(i2) = b#

i2 = i2 + 1

i = i + 1

Next i

For i3 = 0 To UBound(aimpar) - 1

aux = aimpar(i3)

d1 = Int(Mid(aux, 1, 1))

If Len(aux) = 2 Then

d2 = Int(Mid(aimpar(i3), 2, 1))

End If

If Len(aux) = 1 Then

d2 = 0

End If

d1 = d1 + d2

auxim = auxim + d1

Next i3

ncaux = Str(auxim + a#)

ncaux2 = Trim(Mid(ncaux, 3, 1))

ncaux3 = 10 - ncaux2

Dim arrayletras(26) As String

Dim indice As Integer

For indice = 1 To UBound(arrayletras())

arrayletras(indice) = Chr(64 + indice)

Next indice

Dim control As String

If (UCase(strB) = "X") Or (UCase(strB) = "P") Then

ncaux2 = Chr(64 + (10 - Val(ncaux2)))

'ncaux2 = arrayletras((10 - Val(ncaux2)))

For indice = 1 To UBound(arrayletras())

If (ncaux2 = arrayletras(indice)) Then

ncaux2 = indice

Exit For

End If

Next indice

If (strC = indice) Then

control = "El cif es correcto el digito de control calculado por corespondencia con la letra coincide con la ultima cifra"

CalculaCIF = control

Else

control = "El cif no es correcto los digitos de control no coinciden"

CalculaCIF = control

End If

'CalculaCIF = ncaux2

Else

If (strC = ncaux3) Then

control = "El cif es correcto el digito de control calculado coincide con la ultima cifra"

CalculaCIF = control

Else

control = "El cif no es correcto los digitos de control no coinciden"

CalculaCIF = control

End If

'CalculaCIF = ncaux3

End If

End Function

Private Sub cmdCIF_Click()

txtCorrecto_Control.Text = CalculaCIF(txtNIF_CIF.Text)

End Sub