🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: chile.comp.programacion
Article #1227

Re: Ayuda Excel

#1227
From: Ramon Freire A.
Date: Tue, 28 Nov 2006 03:02
319 lines
11622 bytes
a todo esto la funci�n se llama num2word(<n�mero>)

saludos

"Ramon Freire A." <ramonfreire@mailcaliente.com> escribi� en el mensaje
news:ekfjkp$pcl$1@news.nivel5.cl...
> "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
>>
>>
>
>
Technical Details
Message-ID: <ekfqpn$ro8$2@news.nivel5.cl>
Path: arc1-ca.pugleaf.net!g2news2.google.com!news4.google.com!border1.nntp.dca.giganews.com!border2.nntp.dca.giganews.com!nntp.giganews.com!out01a.usenetserver.com!news.usenetserver.com!in01.usenetserver.com!news.usenetserver.com!news-xfer.nntp.sonic.net!news.kjsl.com!news.nivel5.cl!not-for-mail
References: <ek4gi9$ttc$1@news.nivel5.cl> <ek5j7a$3up$1@news.nivel5.cl> <ekfjkp$pcl$1@news.nivel5.cl>

Show Full Headers
Complete Article Headers
X-Google-Thread: 1593cb,2e9a39b2e2562787
X-Google-Attributes: gid1593cb,public
X-Google-Language: SPANISH,ASCII
Path: arc1-ca.pugleaf.net!g2news2.google.com!news4.google.com!border1.nntp.dca.giganews.com!border2.nntp.dca.giganews.com!nntp.giganews.com!out01a.usenetserver.com!news.usenetserver.com!in01.usenetserver.com!news.usenetserver.com!news-xfer.nntp.sonic.net!news.kjsl.com!news.nivel5.cl!not-for-mail
From: "Ramon Freire A." <ramonfreire@mailcaliente.com>
Newsgroups: chile.comp.programacion
Subject: Re: Ayuda Excel
Date: Tue, 28 Nov 2006 00:02:02 -0300
Organization: Varios
Lines: 328
Message-ID: <ekfqpn$ro8$2@news.nivel5.cl>
References: <ek4gi9$ttc$1@news.nivel5.cl> <ek5j7a$3up$1@news.nivel5.cl> <ekfjkp$pcl$1@news.nivel5.cl>
NNTP-Posting-Host: pc-241-8-120-200.cm.vtr.net
X-Trace: news.nivel5.cl 1164668554 28424 200.120.8.241 (27 Nov 2006 23:02:34 GMT)
X-Complaints-To: news@news.nivel5.cl
NNTP-Posting-Date: Mon, 27 Nov 2006 23:02:34 +0000 (UTC)
X-Priority: 3
X-MSMail-Priority: Normal
X-Newsreader: Microsoft Outlook Express 6.00.2900.2869
X-RFC2646: Format=Flowed; Original
X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.2962