Aquí os dejo el código de una aplicación muy simple pero efectiva que poniendo los números del NIF os calcula la letra.

La aplicación tiene la particularidad de permanecer siempre visible en la esquina inferior derecha y ocupar poco espacio, de esta manera es posible tenerla a mano mientras se trabaja con otras aplicaciones y no nos quita visión.

A continuación voy a dejar el código pero si alguien está interesado en la aplicación completa no tiene mas que decirlo y subo una instalación para que la descarguéis.

El programa se compone de un módulo con el siguiente código:

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Public Declare Function SetWindowPos Lib "user32" _
  2. (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _
  3. ByVal x As Long, ByVal y As Long, _
  4. ByVal cx As Long, ByVal cy As Long, _
  5. ByVal wFlags As Long) As Long
  6. Public Const HWND_TOPMOST = -1

Y un formulario con el siguiente código:

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Private Sub CalculaNIF(strA As String)
  2. Const cCADENA = "TRWAGMYFPDXBNJZSQVHLCKE"
  3. Const cNUMEROS = "0123456789"
  4. Dim strT As String, strB As String
  5. Dim a#, Nif#, b#, c#
  6. Dim i As Integer
  7.  
  8. strT = Trim$(strA)
  9. If Len(strT) = 0 Then Exit Sub
  10.  
  11. strB = ""
  12.  '---Dejar sólo los números... &
  13. For i = 1 To Len(strA)
  14. If InStr(cNUMEROS, Mid$(strA, i, 1)) Then
  15. strB = strB + Mid$(strA, i, 1)
  16. End If
  17. Next
  18. strA = strB
  19. a# = 0
  20. Nif# = Val(strA)
  21. Do
  22. b# = Int(Nif# / 24)
  23. c# = Nif# - (24 * b#)
  24. a# = a# + c#
  25. Nif# = b#
  26. Loop While b# <> 0
  27. b# = Int(a# / 23)
  28. c# = a# - (23 * b#)
  29. strA = Trim$(strT) + Mid$(cCADENA, c# + 1, 1)
  30. Text2.Text = Mid$(cCADENA, c# + 1, 1)
  31. End Sub
  32.  
  33. Private Sub Command1_Click()
  34. Call CalculaNIF(Text1.Text)
  35. End Sub
  36.  
  37. Private Sub Form_Activate()
  38. Text1.SetFocus
  39. End Sub
  40.  
  41. Private Sub Form_Load()
  42. Me.ScaleMode = vbPixels
  43. SetWindowPos Me.hwnd, HWND_TOPMOST, Me.ScaleLeft, _
  44. Me.ScaleTop, Me.ScaleWidth, Me.ScaleHeight, 0
  45. Move (Screen.Width - Width), (Screen.Height - Height) - 500
  46.  
  47. End Sub
  48.  
  49. Private Sub Text1_GotFocus()
  50. Text1.SelStart = 0
  51. Text1.SelLength = Len(Text1.Text)
  52. End Sub
  53.  
  54. Private Sub Text1_KeyPress(KeyAscii As Integer)
  55. 'MsgBox KeyAscii
  56. Select Case KeyAscii
  57. Case 13
  58. Command1_Click
  59. Text1_GotFocus
  60. Exit Sub
  61. Case 8
  62. Case 46
  63. Case Else
  64. If Not IsNumeric(Chr(KeyAscii)) Then
  65. KeyAscii = 0
  66. End If
  67. End Select
  68. End Sub

También podéis descargar desde aquí los ficheros fuente.


Vota este artículo:
1 Estrella2 Estrellas3 Estrellas4 Estrellas5 Estrellas (No Ratings Yet)
Loading ... Loading ...

Posts anterior y posterior:
«
»


Posts Relacionados: