OOo macro: números en letras


/ Published in: Other
Save to your folder(s)

OpenOffice.org Calc macro para escribir números en letras


Copy this code and paste it in your HTML
  1. REM ** Función que convierte una cantidad pasada como parámetro en su NOMINACION textual
  2. REM ** Autor: Ing. Mauricio Flores Olmos - 2000-2004
  3. REM ** email: [email protected]
  4. REM ** Se permite la distribución siempre que se mantenga la referencia anterior al Autor.
  5. REM *************************
  6. REM ** Forma de Uso:
  7. REM ** Abra la hoja de Cálculo de OpenOffice.org
  8. REM ** Vaya al menu Herramientas y luego a Macro
  9. REM ** Presione el botón Nuevo
  10. REM ** Le aparecerá el editor de StarBasic, elimine las lineas de código que aparecen
  11. REM ** Luego elija el botón "Insertar texto fuente" de la barra de herramientas (icono de carpeta gris con flecha)
  12. REM ** Presione el botón "Compilar" de la misma barra, si no marca ningun error, significa que
  13. REM ** la macro la insertó correctamente.
  14. REM ** Ahora ya se puede usar la macro en la hoja de calculo (y probablemente en otras partes de OpenOffice)
  15. REM ** Elija el menú "Archivo" y luego "Cerrar"
  16. REM ** Ahora probemos la macro de dos formas:
  17. REM ** 1.- Teclee un valor en alguna celda, ej. 1253.21 en la celda A1 y presione ENTER
  18. REM ** luego en la celda en que estemos (A2) teclee: =aletra(A1) y presione ENTER
  19. REM ** aparecerá: UN MIL DOSCIENTOS CINCUENTA PESOS 21/100 M.N.
  20. REM ** 2.- Teclee lo sigueinte en una celda (Ej. C1): =aletra(563.88) y presione ENTER
  21. REM ** aparecerá: QUINIENTOS SESENTA Y TRES PESOS 88/100 M. N.
  22. REM ** eso es todo...
  23.  
  24. REM ** CUERPO PRINCIPAL DEL MACRO:
  25. REM ** NO CAMBIA NADA DEL código PARA QUE FUNCIONE
  26. REM ** UNA VEZ PEGADO EL código DA GUARDAR
  27. REM ** CIERRE EL MACRO
  28.  
  29. Public Function NumLet(ByVal Numero As Double) As String
  30. Dim NumTmp As String
  31. Dim co1 As Integer
  32. Dim co2 As Integer
  33. Dim pos As Integer
  34. Dim dig As Integer
  35. Dim cen As Integer
  36. Dim dec As Integer
  37. Dim uni As Integer
  38. Dim letra1 As String
  39. Dim letra2 As String
  40. Dim letra3 As String
  41. Dim Leyenda As String
  42. Dim TFNumero As String
  43.  
  44. NumTmp = Format(Numero, "000000000000000") 'Le da un formato fijo
  45. co1 = 1
  46. pos = 1
  47. TFNumero = ""
  48. 'Para extraer tres digitos cada vez
  49. Do While co1 <= 5
  50. co2 = 1
  51. Do While co2 <= 3
  52. 'Extrae un digito cada vez de izquierda a derecha
  53. dig = Val(Mid(NumTmp, pos, 1))
  54. Select Case co2
  55. Case 1: cen = dig
  56. Case 2: dec = dig
  57. Case 3: uni = dig
  58. End Select
  59. co2 = co2 + 1
  60. pos = pos + 1
  61. Loop
  62. letra3 = Centena(uni, dec, cen)
  63. letra2 = Decena(uni, dec)
  64. letra1 = Unidad(uni, dec)
  65. Select Case co1
  66. Case 1
  67. If cen + dec + uni = 1 Then
  68. Leyenda = "billon "
  69. ElseIf cen + dec + uni > 1 Then
  70. Leyenda = "billones "
  71. End If
  72. Case 2
  73. If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then
  74. Leyenda = "mil millones "
  75. ElseIf cen + dec + uni >= 1 Then
  76. Leyenda = "mil "
  77. End If
  78. Case 3
  79. If cen + dec = 0 And uni = 1 Then
  80. Leyenda = "millon "
  81. ElseIf cen > 0 Or dec > 0 Or uni > 1 Then
  82. Leyenda = "millones "
  83. End If
  84. Case 4
  85. If cen + dec + uni >= 1 Then
  86. Leyenda = "mil "
  87. End If
  88. Case 5
  89. If cen + dec + uni >= 1 Then
  90. Leyenda = ""
  91. End If
  92. End Select
  93.  
  94. co1 = co1 + 1
  95. TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda
  96. Leyenda = ""
  97. letra1 = ""
  98. letra2 = ""
  99. letra3 = ""
  100. Loop
  101.  
  102. NumLet = TFNumero
  103.  
  104. End Function
  105.  
  106.  
  107.  
  108. Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
  109. ByVal cen As Integer) As String
  110. Dim cTexto As String
  111.  
  112. Select Case cen
  113. Case 1
  114. If dec + uni = 0 Then
  115. cTexto = "cien "
  116. Else
  117. cTexto = "ciento "
  118. End If
  119. Case 2: cTexto = "doscientos "
  120. Case 3: cTexto = "trescientos "
  121. Case 4: cTexto = "cuatrocientos "
  122. Case 5: cTexto = "quinientos "
  123. Case 6: cTexto = "seiscientos "
  124. Case 7: cTexto = "setecientos "
  125. Case 8: cTexto = "ochocientos "
  126. Case 9: cTexto = "novecientos "
  127. Case Else: cTexto = ""
  128. End Select
  129. Centena = cTexto
  130.  
  131. End Function
  132.  
  133.  
  134.  
  135. Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
  136. Dim cTexto As String
  137.  
  138. Select Case dec
  139. Case 1:
  140. Select Case uni
  141. Case 0: cTexto = "diez "
  142. Case 1: cTexto = "once "
  143. Case 2: cTexto = "doce "
  144. Case 3: cTexto = "trece "
  145. Case 4: cTexto = "catorce "
  146. Case 5: cTexto = "quince "
  147. Case 6 To 9: cTexto = "dieci"
  148. End Select
  149. Case 2:
  150. If uni = 0 Then
  151. cTexto = "veinte "
  152. ElseIf uni > 0 Then
  153. cTexto = "veinti"
  154. End If
  155. Case 3: cTexto = "treinta "
  156. Case 4: cTexto = "cuarenta "
  157. Case 5: cTexto = "cincuenta "
  158. Case 6: cTexto = "sesenta "
  159. Case 7: cTexto = "setenta "
  160. Case 8: cTexto = "ochenta "
  161. Case 9: cTexto = "noventa "
  162. Case Else: cTexto = ""
  163. End Select
  164.  
  165. If uni > 0 And dec > 2 Then cTexto = cTexto + "y "
  166.  
  167. Decena = cTexto
  168.  
  169. End Function
  170.  
  171.  
  172.  
  173. Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
  174. Dim cTexto As String
  175.  
  176. If dec <> 1 Then
  177. Select Case uni
  178. Case 1: cTexto = "un "
  179. Case 2: cTexto = "dos "
  180. Case 3: cTexto = "tres "
  181. Case 4: cTexto = "cuatro "
  182. Case 5: cTexto = "cinco "
  183. End Select
  184. End If
  185. Select Case uni
  186. Case 6: cTexto = "seis "
  187. Case 7: cTexto = "siete "
  188. Case 8: cTexto = "ocho "
  189. Case 9: cTexto = "nueve "
  190. End Select
  191.  
  192. Unidad = cTexto
  193.  
  194. End Function
  195.  
  196.  
  197.  
  198. 'Funcion que convierte al plural el argumento pasado
  199. Private Function Plural(ByVal Palabra As String) As String
  200. Dim pos As Integer
  201. Dim strPal As String
  202.  
  203. If Len(Trim(Palabra)) > 0 Then
  204. pos = InStr(1, "aeiou", Right(Palabra, 1), vbTextCompare)
  205. If pos > 0 Then
  206. strPal = Palabra & "s"
  207. Else
  208. strPal = Palabra & "es"
  209. End If
  210. End If
  211. Plural = strPal
  212.  
  213. End Function

URL: http://www.koalasoftmx.net/staticpages/index.php/convertir-numero-a-letras-openoffice/print

Report this snippet


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.