Posted By

j_junyent on 12/02/07


Tagged

spanish macro OpenOfficeorg


Versions (?)

OOo macro: números en letras


 / Published in: Other
 

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

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

  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.  
  66. Select Case co1
  67. Case 1
  68. If cen + dec + uni = 1 Then
  69. Leyenda = "billon "
  70. ElseIf cen + dec + uni > 1 Then
  71. Leyenda = "billones "
  72. End If
  73. Case 2
  74. If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then
  75. Leyenda = "mil millones "
  76. ElseIf cen + dec + uni >= 1 Then
  77. Leyenda = "mil "
  78. End If
  79. Case 3
  80. If cen + dec = 0 And uni = 1 Then
  81. Leyenda = "millon "
  82. ElseIf cen > 0 Or dec > 0 Or uni > 1 Then
  83. Leyenda = "millones "
  84. End If
  85. Case 4
  86. If cen + dec + uni >= 1 Then
  87. Leyenda = "mil "
  88. End If
  89. Case 5
  90. If cen + dec + uni >= 1 Then
  91. Leyenda = ""
  92. End If
  93. End Select
  94.  
  95. co1 = co1 + 1
  96. TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda
  97. Leyenda = ""
  98. letra1 = ""
  99. letra2 = ""
  100. letra3 = ""
  101. Loop
  102.  
  103. NumLet = TFNumero
  104.  
  105. End Function
  106.  
  107.  
  108.  
  109. Private Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
  110. ByVal cen As Integer) As String
  111. Dim cTexto As String
  112.  
  113. Select Case cen
  114. Case 1
  115. If dec + uni = 0 Then
  116. cTexto = "cien "
  117. Else
  118. cTexto = "ciento "
  119. End If
  120. Case 2: cTexto = "doscientos "
  121. Case 3: cTexto = "trescientos "
  122. Case 4: cTexto = "cuatrocientos "
  123. Case 5: cTexto = "quinientos "
  124. Case 6: cTexto = "seiscientos "
  125. Case 7: cTexto = "setecientos "
  126. Case 8: cTexto = "ochocientos "
  127. Case 9: cTexto = "novecientos "
  128. Case Else: cTexto = ""
  129. End Select
  130. Centena = cTexto
  131.  
  132. End Function
  133.  
  134.  
  135.  
  136. Private Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
  137. Dim cTexto As String
  138.  
  139. Select Case dec
  140. Case 1:
  141. Select Case uni
  142. Case 0: cTexto = "diez "
  143. Case 1: cTexto = "once "
  144. Case 2: cTexto = "doce "
  145. Case 3: cTexto = "trece "
  146. Case 4: cTexto = "catorce "
  147. Case 5: cTexto = "quince "
  148. Case 6 To 9: cTexto = "dieci"
  149. End Select
  150. Case 2:
  151. If uni = 0 Then
  152. cTexto = "veinte "
  153. ElseIf uni > 0 Then
  154. cTexto = "veinti"
  155. End If
  156. Case 3: cTexto = "treinta "
  157. Case 4: cTexto = "cuarenta "
  158. Case 5: cTexto = "cincuenta "
  159. Case 6: cTexto = "sesenta "
  160. Case 7: cTexto = "setenta "
  161. Case 8: cTexto = "ochenta "
  162. Case 9: cTexto = "noventa "
  163. Case Else: cTexto = ""
  164. End Select
  165.  
  166. If uni > 0 And dec > 2 Then cTexto = cTexto + "y "
  167.  
  168. Decena = cTexto
  169.  
  170. End Function
  171.  
  172.  
  173.  
  174. Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
  175. Dim cTexto As String
  176.  
  177. If dec <> 1 Then
  178. Select Case uni
  179. Case 1: cTexto = "un "
  180. Case 2: cTexto = "dos "
  181. Case 3: cTexto = "tres "
  182. Case 4: cTexto = "cuatro "
  183. Case 5: cTexto = "cinco "
  184. End Select
  185. End If
  186. Select Case uni
  187. Case 6: cTexto = "seis "
  188. Case 7: cTexto = "siete "
  189. Case 8: cTexto = "ocho "
  190. Case 9: cTexto = "nueve "
  191. End Select
  192.  
  193. Unidad = cTexto
  194.  
  195. End Function
  196.  
  197.  
  198.  
  199. 'Funcion que convierte al plural el argumento pasado
  200. Private Function Plural(ByVal Palabra As String) As String
  201. Dim pos As Integer
  202. Dim strPal As String
  203.  
  204. If Len(Trim(Palabra)) > 0 Then
  205. pos = InStr(1, "aeiou", Right(Palabra, 1), vbTextCompare)
  206. If pos > 0 Then
  207. strPal = Palabra & "s"
  208. Else
  209. strPal = Palabra & "es"
  210. End If
  211. End If
  212. Plural = strPal
  213.  
  214. End Function

Report this snippet  

You need to login to post a comment.