Article View: chile.comp.programacion
Article #1226Re: Ayuda Excel
From: Ramon Freire A.
Date: Tue, 28 Nov 2006 03:01
Date: Tue, 28 Nov 2006 03:01
319 lines
11622 bytes
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:
<ekfqpb$ro8$1@news.nivel5.cl>Path:
arc1-ca.pugleaf.net!g2news2.google.com!news3.google.com!border1.nntp.dca.giganews.com!border2.nntp.dca.giganews.com!nntp.giganews.com!out02a.usenetserver.com!news.usenetserver.com!in01.usenetserver.com!news.usenetserver.com!news-xfer.nntp.sonic.net!news.kjsl.com!news.nivel5.cl!not-for-mailReferences:
<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!news3.google.com!border1.nntp.dca.giganews.com!border2.nntp.dca.giganews.com!nntp.giganews.com!out02a.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:01:26 -0300 Organization: Varios Lines: 327 Message-ID: <ekfqpb$ro8$1@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 1164668532 28424 200.120.8.241 (27 Nov 2006 23:02:12 GMT) X-Complaints-To: news@news.nivel5.cl NNTP-Posting-Date: Mon, 27 Nov 2006 23:02:12 +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