Convertir Numero en Letras

[javierjava]

Que tal disculpen la molestia entre esta funcion del amigo wolf_kof para convertir numero a letra

Código: (vb) [Seleccionar]

Option Explicit
    Const glbSubS = "CENTAVO"
    Const glbSubP = "CENTAVOS"
    Const glbSubS2 = "cent�simo"
    Const glbSubP2 = "cent�simos"
    Function WordNum(ByVal Numero As String, Optional TipoCambioSingular As String, Optional TipoCambioPlural As String, Optional xInternal As Long) As String
             Dim sNum As String, vNum() As String, X As Long, Y As Long, Z As Long, sTmp As String
             Dim D1 As String, D2 As String, D3 As String, DFinal As String
             Dim tNum As String, B1 As Boolean, B2 As Boolean, B3 As Boolean
             Dim wNum() As String, Nombres() As String
             
             '**********************************************************************************************
            '* Esta funci�n convierte n�meros en palabras, sin importar el contexto donde se encuentren   *
            '* Es capaz de procesar n�meros de 123 d�gitos (Vigintillones) :-O                            *
            '* Solo se procesan 2 decimales si los hay                                                    *
            '**********************************************************************************************
           
             'Convierte el valor en un string
            sNum = Trim(Replace(CStr(Numero), ",", "."))
           
             'Procesa cada n�mero que exista en la variable por separado
            If xInternal = 0 Then
                'Separa los n�meros limpios de las palabras y los procesa por separado (no incluye n�meros con letras)
               wNum = Split(sNum, Space(1))
                For X = 0 To UBound(wNum)
                    'Concatena los strings o n�meros seg�n corresponda
                   If IsNumeric(wNum(X)) Then
                       'Separa los enteros de los decimales para procesarlos por separado
                      If InStr(1, wNum(X), ".", vbTextCompare) > 0 Then
                          'Proceso los enteros
                         D1 = Left(wNum(X), InStrRev(wNum(X), ".", , vbTextCompare) - 1)
                          DFinal = DFinal & IIf(D1 < 0, "menos ", "") & WordNum(D1, TipoCambioSingular, TipoCambioPlural, 1)
                          'Proceso 2 decimales
                         D2 = Mid(Mid(wNum(X), InStrRev(wNum(X), ".", , vbTextCompare) + 1), 1, 2)
                          If Val(D2) > 0 Then
                             If Left(D2, 1) = "0" Then DFinal = DFinal & " CON " & WordNum(D2, glbSubS2, glbSubP2, 1) & Space(1) Else DFinal = DFinal & " CON " & WordNum(D2, glbSubS, glbSubP, 1) & Space(1)
                          End If
                       Else
                          DFinal = DFinal & IIf(wNum(X) < 0, "MENOS ", "") & WordNum(wNum(X), TipoCambioSingular, TipoCambioPlural, 1) & Space(1)
                       End If
                    Else
                       DFinal = DFinal & wNum(X) & Space(1)
                    End If
                Next
             Else
               
                'Elimina el signo
               If Not IsNumeric(Left(sNum, 1)) Then
                   sNum = Mid(sNum, 2)
                End If
             
                'Elimina cualquier formato posible (incluye valores cient�ficos)
               'sNum = Format(sNum, "0")
               
                If sNum = vbNullString Then sNum = "0"
               
                'Completa con ceros a la izquierda hasta obtener una longitud m�ltiplo de 3
               Do While Len(sNum) Mod 3 <> 0
                   sNum = "0" & sNum
                Loop
             
                'Dimenciona un arreglo con espacio para cada una de las centenas
               ReDim vNum(Len(sNum) / 3 - 1)
               
                'Carga el arreglo con las centenas que corresponda
               For X = 0 To UBound(vNum, 1)
                    vNum(X) = Mid(sNum, (X + 1) * 3 - 2, 3)
                Next
                 
                'Si el arreglo contiene una sola centena, la convierte en palabras
               If UBound(vNum, 1) = 0 Then
                    'Asigna los d�gitos de la centena y recuerda si son mayores que cero
                   D3 = Left(sNum, 1): B3 = Val(D3) > 0
                    D2 = Mid(sNum, 2, 1): B2 = Val(D2) > 0
                    D1 = Right(sNum, 1): B1 = Val(D1) > 0
                   
                    'Procesa las unidades
                   Select Case D1
                           Case "1": DFinal = "UN"
                           Case "2": DFinal = "DOS"
                           Case "3": DFinal = "TRES"
                           Case "4": DFinal = "CUATRO"
                           Case "5": DFinal = "CINCO"
                           Case "6": DFinal = "SEIS"
                           Case "7": DFinal = "SIETE"
                           Case "8": DFinal = "OCHO"
                           Case "9": DFinal = "NUEVE"
                    End Select
                   
                    'Procesa las decenas
                   Select Case D2
                           Case "1"
                                'Maneja l�gica del retrasado mental que puso nombres il�gicos a algunos n�meros.
                               Select Case D1
                                       Case "0": DFinal = "DIEZ"
                                       Case "1": DFinal = "ONCE" 'dieciuno
                                      Case "2": DFinal = "DOCE" 'diecidos
                                      Case "3": DFinal = "TRECE" 'diecitres
                                      Case "4": DFinal = "CATORCE" 'diecicuatro
                                      Case "5": DFinal = "QUINCE" 'diecicinco
                                      Case "6": DFinal = "DIECISEIS" 'acento :(
                                      Case Else
                                            DFinal = "DIECI" & DFinal
                                End Select
                           Case "2"
                                If B1 Then
                                   If D1 = "2" Then DFinal = "DOS"
                                   If D1 = "3" Then DFinal = "TRES"
                                   DFinal = "VEINTI" & DFinal
                                Else
                                   DFinal = "VEINTE"
                                End If
                           Case "3": If B1 Then DFinal = "TREINTA Y " & DFinal Else DFinal = "TREINTA"
                           Case "4": If B1 Then DFinal = "CUARENTA Y " & DFinal Else DFinal = "CUARENTA"
                           Case "5": If B1 Then DFinal = "CINCUENTA Y " & DFinal Else DFinal = "CINCUENTA"
                           Case "6": If B1 Then DFinal = "SESENTA Y " & DFinal Else DFinal = "SESENTA"
                           Case "7": If B1 Then DFinal = "SETENTA Y " & DFinal Else DFinal = "SETENTA"
                           Case "8": If B1 Then DFinal = "OCHENTA Y " & DFinal Else DFinal = "OCHENTA"
                           Case "9": If B1 Then DFinal = "NOVENTA Y " & DFinal Else DFinal = "NOVENTA"
                    End Select
                   
                    'Procesa las centenas
                   Select Case D3
                           Case "1": If B1 Or B2 Then DFinal = "CIENTO " & DFinal Else DFinal = "CIEN"
                           Case "2": If B1 Or B2 Then DFinal = "DOSCIENTOS " & DFinal Else DFinal = "DOSCIENTOS"
                           Case "3": If B1 Or B2 Then DFinal = "TRESCIENTOS " & DFinal Else DFinal = "TRESCIENTOS"
                           Case "4": If B1 Or B2 Then DFinal = "CUATROCIENTOS " & DFinal Else DFinal = "CUATROCIENTOS"
                           Case "5": If B1 Or B2 Then DFinal = "QUINIENTOS " & DFinal Else DFinal = "QUINIENTOS"
                           Case "6": If B1 Or B2 Then DFinal = "SEISCIENTOS " & DFinal Else DFinal = "SEISCIENTOS"
                           Case "7": If B1 Or B2 Then DFinal = "SETECINETOS " & DFinal Else DFinal = "SETECIENTOS"
                           Case "8": If B1 Or B2 Then DFinal = "OCHOCIENTOS " & DFinal Else DFinal = "OCHOCIENTOS"
                           Case "9": If B1 Or B2 Then DFinal = "NOVECIENTOS " & DFinal Else DFinal = "NOVECIENTOS"
                    End Select
                   
                    'Si es la ejecuci�n principal efectua algunos arreglines
                   If xInternal = 1 Then
                       'Validaci�n del cero
                      If Trim(DFinal) = 0 Then DFinal = "CERO"
                       'Validaci�n de terminados en "un"
                      If Right(DFinal, 2) = "UN" And Len(TipoCambioSingular) = 0 Then DFinal = DFinal & "O"
                    End If
                   
                Else 'Si es m�s de una centena, las separa y procesa independientemente
                   Y = -1
                    Z = 1
                    For X = UBound(vNum) To 0 Step -1
                        Y = Y + 1
                       
                        'Convierte la centena en palabras
                       tNum = WordNum(vNum(X), xInternal:=2)
                       
                        'Arregla la terminaci�n "uno" cuando corresponde
                       If Y = 0 And Right(tNum, 2) = "UN" And TipoCambioSingular & TipoCambioPlural = "" Then tNum = tNum + "O"
                       
                        'Genera un valor temporal para poder modificar
                       sTmp = tNum
                       
                        'Asigna los nombres gen�ricos principales
                       Nombres = Split(" MIL , MILL�N , MILLONES , Bill�n , Billones , Trill�n , Trillones , Cuatrill�n , cuatrillones , quintill�n , quintillones , sextill�n , sextillones , septill�n , septillones , octill�n , octillones , nonill�n , nonillones , decill�n , decillones , undecill�n , undecillones , duodecill�n , duodecillones , tredecill�n , tredecillones , cuatordecill�n , cuatordecillones , quindecill�n , quindecillones , sexdecill�n , sexdecillones , septendecill�n , septendecillones , octodecill�n , octodecillones , novendecill�n , novendecillones , vigintill�n , vigintillones ", ",")
                       
                        'Controla que el �ndice de nombres no salga de los l�mites
                       If Y > UBound(Nombres) Then
                           WordNum = "?"
                           Exit Function
                        End If
                       
                        'Asigna los nombres correspondientes
                       If Y Mod 2 > 0 Then
                           D1 = Nombres(0)
                           D2 = Nombres(Y - 1)
                        ElseIf Y > 0 Then
                           D1 = Nombres(Y - 1)
                           D2 = Nombres(Y)
                        Else
                           D1 = "": D2 = ""
                        End If
                       
                        'Actualiza el nombre del n�mero
                       Select Case Y Mod 2
                               Case 0: If sTmp = "UN" Then sTmp = sTmp & D1 Else sTmp = sTmp & IIf(tNum = "", "", D2)
                               Case Else
                                    If sTmp = "UN" Then sTmp = ""
                                    sTmp = sTmp & IIf(tNum = "", "", D1)
                                    If X = 0 And Y > 1 Then
                                       If InStr(1, DFinal, D2, vbTextCompare) = 0 Then sTmp = sTmp & Mid(D2, 2)
                                    End If
                        End Select
                        DFinal = sTmp & DFinal
                    Next
                End If
             End If
             
             'Aplica el tipo de moneda cuando corresponda
            If xInternal = 1 Then DFinal = DFinal & Space(1) & IIf(Format(sNum, "#0") = "1", TipoCambioSingular, TipoCambioPlural)
       
             'Asigna el n�mero en palabras
             WordNum = Trim(DFinal)
    End Function



Código: [Seleccionar]

Text1.Text = WordNum(Text2.Text, "QUETZAL", "QUETZALES")funciona bien cuando uso esta cantidad 1500.00 pero cuando uso la coma para separ los miles  no los conviete a texto solo copia la cantidad de esta forma 1.500.00, no solo con esta cantidad, lo hace con cualquier cantidad que este separado por una ","  ya busque donde esta el error pero no di     alguien seria tan amable para ayudarme.

Gracias

[erbuson]

Hola:

Si el problema lo tienes en que cuando pones 1,500.00 en lugar de 1500.00 es muy facil una 'chapuza' pero evidentemente va a funcionar, si en tu llamada lo haces en lugar de así:

Text1.Text = WordNum(Text2.Text, "QUETZAL", "QUETZALES")

Con el Replace, que sólo actuará si la coma existe sustituyendo la coma por nulo

Text1.Text = WordNum(Replace(Text2.Text,",","") , "QUETZAL", "QUETZALES")

Fíjate que su funcion lo que hace es  sNum = Trim(Replace(CStr(Numero), ",", ".")) con lo cual convierte tu 1,500.00 en 1.500.00

Saludos

[javierjava]

Woo que bien muchas gracias funciona rebien


Gracias 

[wolf_kof]

En la primera linea del Modulo:

Código: [Seleccionar]

sNum = Trim(Replace(CStr(Numero), ",", "."))
Modificala a esta:

Código: [Seleccionar]

sNum = Trim(Replace(CStr(Numero), ",", ""))
y asunto arreglado, a sí no tienes que hacer nada más para el

Código: [Seleccionar]

Label1.Caption = WordNum(Text1.Text, "Quetzal", "Quetzales")