🚀 go-pugleaf

"Nicotinomaniaco" <NoWeeE[shelo99]@yahoo.com> escribi� en el mensaje 
news:ek5j7a$3up$1@news.nivel5.cl...
> Si ese programa funciona, entonces trad�celo. Busca todos los textos que 
> est�n entre comillas y cambialos por sus respectivos en espa�ol. Aun as�, 
> en ingl�s los n�meros se dicen un poco diferentes de en espa�ol. Ellos 
> dicen "Twenty five", nosotros "veinticinco", lo que podr�as dejar como 
> "veinte y cinco". Por lo tanto, traduce "Twenty" a "Veinte y "

yo lo hice con una funcion.. qued� un poco largo pero ... es lo que hay :)
hay que pegarlo en un M�dulo de excel, tolera n�meros Enteros solamente y 
ocupa 3 funciones en total

saludos


-------------------------------------------------------------------------------
Function LenMbcs(ByVal str As String)
    LenMbcs = LenB(StrConv(str, vbFromUnicode))
End Function
Function gls_number(shortnumber)
'Esta funci�n entrega en palabras la cifra contenida en shortnumber, pero 
esta debe ser, a lo mas
'de 3 caracteres.
'utiliza la funcion LenNMbcs para conseguir el largo ASCII de los numeros
'Made by RFA

Dim hundreds As Variant
Dim decenes1 As Variant
Dim decenes2 As Variant
Dim rest As Integer
Dim text As String

'Define arreglos para busqueda de cifras en letras
hundreds = Array("cien", "docientos", "trescientos", "cuatrocientos", 
"quinientos", "seiscientos", "setecientos", "ochocientos", "novecientos")
decenes1 = Array("un", "dos", "tres", "cuatro", "cinco", "seis", "siete", 
"ocho", "nueve", "diez", "once", "doce", "trece", "catorce", "quince", 
"diecis�is", "diecisiete", "dieciocho", "diecinueve", "veinte", "veinti�n", 
"veintid�s", "veintitr�s", "veinticuatro", "veiticinco", "veintis�is", 
"veintisiete", "veintiocho", "veintinueve")
decenes2 = Array("treinta", "cuarenta", "cincuenta", "sesenta", "setenta", 
"ochenta", "noventa")

'Inicializa Variables
rest = shortnumber
text = ""

'Valida las centenas de la cifra ingresada
    If LenMbcs(rest) = 3 Then
        text = text & hundreds(Mid(rest, 1, 1) - 1)
        rest = rest - Mid(rest, 1, 1) * 100
        If rest > 0 Then
            If shortnumber <= 199 Then
                text = text & "to "
            Else
                text = text & " "
            End If
        End If
    End If

'Valida el Resto del numero, una vez descontadas las centenas (dos digitos)
    If LenMbcs(rest) = 2 Then
        If rest <= 29 Then
            If rest > 10 Then
                text = text & decenes1(Mid(rest, 1, 2) - 1)
                rest = rest - Mid(rest, 1, 1)
            Else
                text = text & decenes1(Mid(rest, 1, 2) - 1)
                rest = rest - Mid(rest, 1, 1) * 10
            End If
        Else
            text = text & decenes2(Mid(rest, 1, 1) - 3)
            rest = rest - Mid(rest, 1, 1) * 10
            If LenMbcs(rest) = 1 And rest > 0 Then
                text = text & " y " & decenes1(Mid(rest, 1, 1) - 1)
                rest = rest - Mid(rest, 1, 1)
            End If
        End If
    End If

'Valida numeros menores o iguales a 9 (solo un digito)
    If LenMbcs(rest) = 1 And rest > 0 Then
        text = text & decenes1(Mid(rest, 1, 1) - 1)
        rest = rest - Mid(rest, 1, 1)
    End If

gls_number = text

End Function
Function num2word(number) ',measure As String)
'Convierte en palabras el numero ingresado
'Por default los n�meros son en pesos

Dim unit As Variant
Dim unit2 As Variant
Dim netvalue As Long
Dim ammount As Long
Dim lenght As Integer
Dim curr As String

If number > 2147483647 Then
    num2word = "S�lo valores hasta 2,147,483,617"
    Exit Function
End If

If number <> Round(number, 0) Then
    num2word = "S�lo n�meros enteros"
    Exit Function
End If

curr = "pesos"

If number >= 0 Then
    netvalue = number
    If number = 0 Then
        text = "cero"
    End If
Else
    netvalue = -number
    text = "menos"
End If

unit = Array("trill�n", "bill�n", "mill�n", "mil", "")
unit2 = Array("trillones", "billones", "millones", "mil", "")

If IsNull(number) Or number = "" Then
    num2word = "ERROR: DATO NULO"
    Exit Function
End If

'asigna montos
For i = 5 To 1 Step -1
    largo = LenMbcs(netvalue)
    If largo >= (3 * i - 2) Then
        ammount = Mid(netvalue, 1, largo - 3 * (i - 1))
        If ammount > 0 And LenMbcs(number) >= (3 * i + 1) Then
            text = text & " "
        End If
        text = text & gls_number(ammount)
        netvalue = netvalue - ammount * 10 ^ (3 * (i - 1))
        If ammount = 1 Then
            text = text & " " & unit(5 - i)
        Else
            text = text & " " & unit2(5 - i)
        End If
    End If
Next i

'define el nombre de unidades
    If number <= 1 And number >= -1 Then
        text = text & Mid(curr, 1, LenMbcs(curr) - 1)
    Else
        text = text & curr
    End If

num2word = text

End Function
-------------------------------------------------------------------------------







>
> "JFG" <pidelo@pidelo.cl> escribi� en el mensaje 
> news:ek4gi9$ttc$1@news.nivel5.cl...
>> Como puedo leer un numero y dejarlo como texto en excel??
>>
>> por ejemplo
>>
>> si tengo en una celda con valor 100 que otra columna diga
>>
>> "cien pesos"
>>
>> lo �nico que encontr� fue esto, pero esta en ingles, cambi� algunas 
>> variables en comillas, pero no me da un resultado eficiente..
>>
>> saludos!!
>>
>>
>>
>> Option Explicit
>> 'Main Function
>> Function SpellNumber(ByVal MyNumber)
>>     Dim Dollars, Cents, Temp
>>     Dim DecimalPlace, Count
>>     ReDim Place(9) As String
>>     Place(2) = " Thousand "
>>     Place(3) = " Million "
>>     Place(4) = " Billion "
>>     Place(5) = " Trillion "
>>     ' String representation of amount.
>>     MyNumber = Trim(Str(MyNumber))
>>     ' Position of decimal place 0 if none.
>>     DecimalPlace = InStr(MyNumber, ".")
>>     ' Convert cents and set MyNumber to dollar amount.
>>     If DecimalPlace > 0 Then
>>         Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
>>                   "00", 2))
>>         MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
>>     End If
>>     Count = 1
>>     Do While MyNumber <> ""
>>         Temp = GetHundreds(Right(MyNumber, 3))
>>         If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
>>         If Len(MyNumber) > 3 Then
>>             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
>>         Else
>>             MyNumber = ""
>>         End If
>>         Count = Count + 1
>>     Loop
>>     Select Case Dollars
>>         Case ""
>>             Dollars = "No Dollars"
>>         Case "One"
>>             Dollars = "One Dollar"
>>          Case Else
>>             Dollars = Dollars & " Dollars"
>>     End Select
>>     Select Case Cents
>>         Case ""
>>             Cents = " and No Cents"
>>         Case "One"
>>             Cents = " and One Cent"
>>               Case Else
>>             Cents = " and " & Cents & " Cents"
>>     End Select
>>     SpellNumber = Dollars & Cents
>> End Function
>>
>> ' Converts a number from 100-999 into text
>> Function GetHundreds(ByVal MyNumber)
>>     Dim Result As String
>>     If Val(MyNumber) = 0 Then Exit Function
>>     MyNumber = Right("000" & MyNumber, 3)
>>     ' Convert the hundreds place.
>>     If Mid(MyNumber, 1, 1) <> "0" Then
>>         Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
>>     End If
>>     ' Convert the tens and ones place.
>>     If Mid(MyNumber, 2, 1) <> "0" Then
>>         Result = Result & GetTens(Mid(MyNumber, 2))
>>     Else
>>         Result = Result & GetDigit(Mid(MyNumber, 3))
>>     End If
>>     GetHundreds = Result
>> End Function
>>
>> ' Converts a number from 10 to 99 into text.
>> Function GetTens(TensText)
>>     Dim Result As String
>>     Result = ""           ' Null out the temporary function value.
>>     If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
>>         Select Case Val(TensText)
>>             Case 10: Result = "Ten"
>>             Case 11: Result = "Eleven"
>>             Case 12: Result = "Twelve"
>>             Case 13: Result = "Thirteen"
>>             Case 14: Result = "Fourteen"
>>             Case 15: Result = "Fifteen"
>>             Case 16: Result = "Sixteen"
>>             Case 17: Result = "Seventeen"
>>             Case 18: Result = "Eighteen"
>>             Case 19: Result = "Nineteen"
>>             Case Else
>>         End Select
>>     Else                                 ' If value between 20-99...
>>         Select Case Val(Left(TensText, 1))
>>             Case 2: Result = "Twenty "
>>             Case 3: Result = "Thirty "
>>             Case 4: Result = "Forty "
>>             Case 5: Result = "Fifty "
>>             Case 6: Result = "Sixty "
>>             Case 7: Result = "Seventy "
>>             Case 8: Result = "Eighty "
>>             Case 9: Result = "Ninety "
>>             Case Else
>>         End Select
>>         Result = Result & GetDigit _
>>             (Right(TensText, 1))  ' Retrieve ones place.
>>     End If
>>     GetTens = Result
>> End Function
>>
>> ' Converts a number from 1 to 9 into text.
>> Function GetDigit(Digit)
>>     Select Case Val(Digit)
>>         Case 1: GetDigit = "One"
>>         Case 2: GetDigit = "Two"
>>         Case 3: GetDigit = "Three"
>>         Case 4: GetDigit = "Four"
>>         Case 5: GetDigit = "Five"
>>         Case 6: GetDigit = "Six"
>>         Case 7: GetDigit = "Seven"
>>         Case 8: GetDigit = "Eight"
>>         Case 9: GetDigit = "Nine"
>>         Case Else: GetDigit = ""
>>     End Select
>> End Function
>>
>> -- 
>> El vino ahoga todas las penas, y no es chiste....
>>
>> JFG
>
>