[RESUELTO]Problema Macros Numeros a Letras Numlet y un y uno

Desarrollo de Macros y programación en UNO, usar las API, llamar programas externos...

[RESUELTO]Problema Macros Numeros a Letras Numlet y un y uno

Notapor Andrespy » Jue Sep 27, 2012 9:19 pm

(AUXILIO) soy nuevo no se usar muy bien el foro pero este es un mail que envié a contacto universo libre Mauricio

Hola que tal, te contacto por tu espectacular macro NUMEROS A LETRAS
y el tema es el siguiente, no se nada de macros pero instalé eso en mi libreoffice cal 3.4
usando la siguiente formula que escribo de ejemplo a continuación =Numlet(A4)
puesto que no necesito en mi pais o en lo que estoy utilizando ninguna de las otras llamadas como moneda pesos dolares ni la parte de fracciones del final!
y mi problema real reside en la parte en letras UNIDAD "y" "un"
EJEMPLO
este monto
2.551.551 (con la formula =Numlet(celda)
dos millones quinientos cincuenta y un mil quinientos cincuenta y un (aqui reside mi problema por que lo que necesito es:)
2.551.551 (con formula =numlet(celda)
dos millones quinientos cincuenta y un mil quinientos cincuenta y uno (la palabra 1 del medio esta bien dicha "y un" mil pero en el final necesito que diga "y uno"
lo que pasa que en ambos dice "y un" y si cambio en el codigo en ambos dice y uno y asi también queda mal en el medio puesto que allí deba decir "y un" y al final "y uno"

Desde ya muchas gracias y espero con muchisimas ansias tu respuesta

Andres Mareco
Desde Paraguay
Última edición por Andrespy el Vie Sep 28, 2012 12:30 am, editado 1 vez en total
Andrespy
Versión: 6.1.3.2
Id. de compilación: 10(Build:2)
Subprocs. CPU: 1; SO: Linux 4.4; Repres. IU: predet.; VCL: gtk3_kde5;
Configuración regional: es-PY (es_PY.UTF-8); Calc: group threaded
Sistema operativo OpenSuse leap 42.3
Andrespy
 
Mensajes: 4
Registrado: Jue Sep 27, 2012 8:31 pm

Re: Problema Macros Numeros a Letras Numlet "y un" "y uno"

Notapor mauricio » Jue Sep 27, 2012 10:29 pm

Pues aplicando la lógica, solo debe de cambiar cuando sea la ultima posición, cambia las siguientes líneas en el código:
Código: Seleccionar todo   Expandir vistaContraer vista
    letra3 = Centena(uni, dec, cen)
    letra2 = Decena(uni, dec)
    letra1 = Unidad(uni, dec, co1)

Y actualizar la función unidad de la siguiente manera:
Código: Seleccionar todo   Expandir vistaContraer vista
Private Function Unidad(ByVal uni As Integer, ByVal dec As Integer, ByVal pos As Integer) As String
Dim cTexto As String
 
  If dec <> 1 Then
    Select Case uni
      Case 1:
         If pos = 5 Then
            cTexto = "uno"
         Else
            cTexto = "un "
       End If
      Case 2: cTexto = "dos "
      Case 3: cTexto = "tres "
      Case 4: cTexto = "cuatro "
      Case 5: cTexto = "cinco "
    End Select
  End If
  Select Case uni
    Case 6: cTexto = "seis "
    Case 7: cTexto = "siete "
    Case 8: cTexto = "ocho "
    Case 9: cTexto = "nueve "
  End Select
 
  Unidad = cTexto

End Function

Nos cuentas si funciono...

Saludos
______________________________________________
"Todo cuanto no podemos dar nos posee". - André Gide
LibreOffice 6.2 | ArchLinux | Gnome3
No respondo preguntas privadas, por favor, usa el foro
Avatar de Usuario
mauricio
 
Mensajes: 5878
Registrado: Sab Nov 22, 2008 5:36 am
Ubicación: CDMX

Re: Problema Macros Numeros a Letras Numlet "y un" "y uno"

Notapor Andrespy » Jue Sep 27, 2012 11:36 pm

Bueno este es la macro de Mauricio que yo tengo en mi libre office pero no se donde mismo insertar lo que me has escrito puesto que no se nada de macros ni de codificacion basic
Código: Seleccionar todo   Expandir vistaContraer vista
Option Explicit
'*************************************************************************************************
'   FUNCION PARA CONVERTIR NUMEROS A LETRAS
'
'   Copyright (C) 2005 Mauricio Baeza Servin
'   Este programa es software libre. Puede redistribuirlo y/o modificarlo bajo los términos de la
'   Licencia Pública General de GNU según es publicada por la Free Software Foundation, bien de la
'   versión 2 de dicha Licencia o bien (según su elección) de cualquier versión posterior.
'
'   Este programa se distribuye con la esperanza de que sea útil, pero SIN NINGUNA GARANTÍA, incluso
'   sin la garantía MERCANTIL implícita o sin garantizar la CONVENIENCIA PARA UN PROPÓSITO PARTICULAR.
'   Véase la Licencia Pública General de GNU para más detalles.
'
'   Debería haber recibido una copia de la Licencia Pública General junto con este programa. Si no ha
'   sido así, escriba a la Free Software Foundation, Inc., en 675 Mass Ave, Cambridge, MA 02139, EEUU.
'
'   Mauricio Baeza
'
'*************************************************************************************************
'Hago uso de variables bastante explicitas para facilitar la lectura del codigo
'Los comentarios cumplen y complementan la misma funcion

'Ultima modificacion Octubre del 2002
'Argumentos:
'Numero = Valor que deseamos convertir en texto
'Moneda = es el nombre de la moneda a mostrar
'Fraccion_Letras = Verdadero para que la fraccion de la moneda
'                 tambien la convierta a letras
'Fraccion = Es el nombre de la fraccion de la moneda
'Texto_Inicial = Cualquier texto que quieras al principio del resultado
'Texto_Final = Cualquier texto que quieras al finla del resultado
'Estilo = Formato de salida
'           1 = MAYUSCULAS
'           2 = minusculas
'           3 = Tipo Titulo
'Los valores negativos los convierte a positivos
'El valor minimo en 0, el valor maximo es  9,999,999,999,999.99

Function Numeros_Letras(ByVal Numero As Double, _
                    ByVal Moneda As String, _
                    ByVal Fraccion_Letras As Boolean , _
                    ByVal Fraccion As String, _
                    ByVal Texto_Inicial As String, _
                    ByVal Texto_Final As String, _
                    ByVal Estilo As Integer) As String
Dim strLetras As String
Dim NumTmp As String
Dim intFraccion As Integer

  strLetras = Texto_Inicial
  'Convertimos a positivo si es negativo
  Numero = Abs(Numero)
  NumTmp = Format(Numero, "000000000000000.00")
  If Numero < 1 Then
    strLetras = strLetras & "CERO " & Plural(Moneda) & " "
  Else
    strLetras = strLetras & NumLet(Val(Left(NumTmp, 15)))
    If Val(NumTmp) = 1 Or Val(NumTmp) < 2 Then
      strLetras = strLetras & Moneda & " "
    ElseIf Val(Mid(NumTmp, 4, 12)) = 0 Or Val(Mid(NumTmp, 10, 6)) = 0 Then
      strLetras = strLetras & "DE " & Plural(Moneda) & " "
    Else
      strLetras = strLetras & Plural(Moneda) & " "
    End If
  End If
  If Fraccion_Letras Then
    intFraccion = Val(Right(NumTmp, 2))
    Select Case intFraccion
      Case 0
        strLetras = strLetras & "CON CERO " & Plural(Fraccion)
      Case 1
        strLetras = strLetras & "CON UN " & Fraccion
      Case Else
        strLetras = strLetras & "CON " & NumLet(Val(Right(NumTmp, 2))) & Plural(Fraccion)
    End Select
  Else
    strLetras = strLetras & Right(NumTmp, 2)
  End If
  strLetras = strLetras & Texto_Final
  Select Case Estilo
    Case 1
      strLetras = UCase(strLetras)
    Case 2
      strLetras = LCase(strLetras)
    Case 3
      strLetras = strLetras          'StrConv(strLetras, vbProperCase)
  End Select
   
  Numeros_Letras = strLetras
 
End Function


Function NumLet(ByVal Numero As Double) As String
  Dim NumTmp As String
  Dim co1 As Integer
  Dim co2 As Integer
  Dim pos As Integer
  Dim dig As Integer
  Dim cen As Integer
  Dim dec As Integer
  Dim uni As Integer
  Dim letra1 As String
  Dim letra2 As String
  Dim letra3 As String
  Dim Leyenda As String
  Dim TFNumero As String
       
  NumTmp = Format(Numero, "000000000000000")        'Le da un formato fijo
  co1 = 1
  pos = 1
  TFNumero = ""
  'Para extraer tres digitos cada vez
  Do While co1 <= 5
    co2 = 1
    Do While co2 <= 3
      'Extrae un digito cada vez de izquierda a derecha
      dig = Val(Mid(NumTmp, pos, 1))
      Select Case co2
        Case 1: cen = dig
        Case 2: dec = dig
        Case 3: uni = dig
      End Select
      co2 = co2 + 1
      pos = pos + 1
    Loop
    letra3 = Centena(uni, dec, cen)
    letra2 = Decena(uni, dec)
    letra1 = Unidad(uni, dec)
           
    Select Case co1
      Case 1
        If cen + dec + uni = 1 Then
          Leyenda = "BILLON "
        ElseIf cen + dec + uni > 1 Then
          Leyenda = "BILLONES "
        End If
      Case 2
        If cen + dec + uni >= 1 And Val(Mid(NumTmp, 7, 3)) = 0 Then
          Leyenda = "MIL MILLONES "
        ElseIf cen + dec + uni >= 1 Then
          Leyenda = "MIL "
        End If
      Case 3
        If cen + dec = 0 And uni = 1 Then
          Leyenda = "MILLON "
        ElseIf cen > 0 Or dec > 0 Or uni > 1 Then
          Leyenda = "MILLONES "
        End If
      Case 4
        If cen + dec + uni >= 1 Then
          Leyenda = "MIL "
        End If
      Case 5
        If cen + dec + uni >= 1 Then
          Leyenda = ""
        End If
      End Select
           
      co1 = co1 + 1
      TFNumero = TFNumero + letra3 + letra2 + letra1 + Leyenda
     
      Leyenda = ""
      letra1 = ""
      letra2 = ""
      letra3 = ""
  Loop
       
  NumLet = TFNumero
   
End Function


Function Centena(ByVal uni As Integer, ByVal dec As Integer, _
                         ByVal cen As Integer) As String
Dim cTexto As String

  Select Case cen
    Case 1
      If dec + uni = 0 Then
        cTexto = "CIEN "
      Else
        cTexto = "CIENTO "
      End If
    Case 2: cTexto = "DOSCIENTOS "
    Case 3: cTexto = "TRESCIENTOS "
    Case 4: cTexto = "CUATROCIENTOS "
    Case 5: cTexto = "QUININENTOS "
    Case 6: cTexto = "SEISCIENTOS "
    Case 7: cTexto = "SETECIENTOS "
    Case 8: cTexto = "OCHOCIENTOS "
    Case 9: cTexto = "NOVECIENTOS "
    Case Else: cTexto = ""
  End Select
  Centena = cTexto
   
End Function


Function Decena(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto As String
 
  Select Case dec
    Case 1:
      Select Case uni
        Case 0: cTexto = "DIEZ "
        Case 1: cTexto = "ONCE "
        Case 2: cTexto = "DOCE "
        Case 3: cTexto = "TRECE "
        Case 4: cTexto = "CATORCE "
        Case 5: cTexto = "QUINCE "
        Case 6 To 9: cTexto = "DIECI"
      End Select
    Case 2:
      If uni = 0 Then
        cTexto = "VEINTE "
      ElseIf uni > 0 Then
        cTexto = "VEINTI"
      End If
    Case 3: cTexto = "TREINTA "
    Case 4: cTexto = "CUARENTA "
    Case 5: cTexto = "CINCUENTA "
    Case 6: cTexto = "SESENTA "
    Case 7: cTexto = "SETENTA "
    Case 8: cTexto = "OCHENTA "
    Case 9: cTexto = "NOVENTA "
    Case Else: cTexto = ""
  End Select
 
  If uni > 0 And dec > 2 Then cTexto = cTexto + "Y "
   
  Decena = cTexto
 
End Function


Function Unidad(ByVal uni As Integer, ByVal dec As Integer) As String
Dim cTexto As String
 
  If dec <> 1 Then
    Select Case uni
      Case 1: cTexto = "UN "
      Case 2: cTexto = "DOS "
      Case 3: cTexto = "TRES "
      Case 4: cTexto = "CUATRO "
      Case 5: cTexto = "CINCO "
    End Select
  End If
  Select Case uni
    Case 6: cTexto = "SEIS "
    Case 7: cTexto = "SIETE "
    Case 8: cTexto = "OCHO "
    Case 9: cTexto = "NUEVE "
  End Select
 
  Unidad = cTexto

End Function


'Funcion que convierte al plural el argumento pasado
Private Function Plural(ByVal Palabra As String) As String
Dim pos As Integer
Dim strPal As String

  If Len(Trim(Palabra)) > 0 Then
    pos = InStr(1, "AEIOU", Right(Palabra, 1), 1)
    If pos > 0 Then
      strPal = Palabra & "S"
    Else
      strPal = Palabra & "ES"
    End If
  End If
  Plural = strPal
 
End Function
Última edición por mauricio el Vie Sep 28, 2012 1:58 am, editado 1 vez en total
Razón: Mostrar codigo correctamente
Andrespy
Versión: 6.1.3.2
Id. de compilación: 10(Build:2)
Subprocs. CPU: 1; SO: Linux 4.4; Repres. IU: predet.; VCL: gtk3_kde5;
Configuración regional: es-PY (es_PY.UTF-8); Calc: group threaded
Sistema operativo OpenSuse leap 42.3
Andrespy
 
Mensajes: 4
Registrado: Jue Sep 27, 2012 8:31 pm

Re: [RESUELTO]Problema Macros Numeros a Letras Numlet y un y

Notapor Andrespy » Vie Sep 28, 2012 12:38 am

Perdón por no saber insertar el código en el foro
pero he pensado mucho y me he arriesgado a buscar y encontrar el lugar en donde colocar el código respuesta que me ha dado ["Todo cuanto no podemos dar nos posee". - André Gide AOO 3.4.1 | LibO 3.6 | ArchLinux | Gnome3] Mauricio!
Muchísimas Gracias por la ayuda por que funciono de maravilla Gracias a Dios y a las Grandes Mentes Maestras que les dio a todos!
Me gustaría subir el código como quedo pero no se como hacerlo así que si alguien lo llegara a necesitar cosa que no creo solo me lo piden y veo como se los paso! GRACIAS MAURICIO
Andrespy
Versión: 6.1.3.2
Id. de compilación: 10(Build:2)
Subprocs. CPU: 1; SO: Linux 4.4; Repres. IU: predet.; VCL: gtk3_kde5;
Configuración regional: es-PY (es_PY.UTF-8); Calc: group threaded
Sistema operativo OpenSuse leap 42.3
Andrespy
 
Mensajes: 4
Registrado: Jue Sep 27, 2012 8:31 pm

Re: [RESUELTO]Problema Macros Numeros a Letras Numlet y un y

Notapor SLV-es » Vie Sep 28, 2012 12:29 pm

Hola

Selecciona todo el código del módulo basic, y pulsa Ctrl+C para copìar

Utiliza las siguientes etiquetas (entre corchetes) en tu mensaje, disponibles en la barra de herramientas del editor completo del foro en el botón Code:

Código: Seleccionar todo   Expandir vistaContraer vista
[code]
Pega aquí el código pulsando Ctrl+V
[/code]


Saludos
+info en la web "no oficial" dedicada a OpenOffice en Español
AOO 4.1.2 y LibO 4.4.6 en W10 y en Lliurex
No respondo mensajes privados sobre AOO, por favor, utiliza el foro para tus preguntas
Avatar de Usuario
SLV-es
 
Mensajes: 4894
Registrado: Jue Ago 26, 2010 1:25 am
Ubicación: España

Re: [RESUELTO]Problema Macros Numeros a Letras Numlet y un y

Notapor jasyc » Dom Oct 18, 2015 7:09 pm

cuando escribo 1.250 me devuelve:

un mil doscientos cincuenta

, no puede responder:

mil doscientos cincuenta.
OpenOffice 4.1 en Windows Vista
jasyc
 
Mensajes: 1
Registrado: Dom Oct 18, 2015 7:05 pm


Volver a Macros y API UNO

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 5 invitados