Convertir números en letras

huorsa

Board Regular
Joined
Feb 15, 2002
Messages
101
Quisiera saber si alguien tiene algún código de Visual Basic que convierta los números en letras, es decir si pongo 45.00 en A1 que en A2 obtenga "cuarenta y cinco pesos 00/100".

Se que existe un código para hacer este tipo de transformación en inglés pero como no tengo mucha experiencia con VB pues estoy teniendo problemas para traspasarlo de inglés a español.

Espero me puedan ayudar,

Hugo
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
Abre excel --> presiona ALT-F11 --> insert module --> copy y paste code below.
Code:
Option Explicit

      '****************
      ' Main Function *
      '****************

      Function Letra(ByVal MyNumber)
          Dim Pesos, Centavos, Temp
          Dim DecimalPlace, Count

          ReDim Place(9) As String
          Place(2) = " Mil "
          Place(3) = " Millón "
          Place(4) = " Billón "
          Place(5) = " Trillón "

          ' String representation of amount.
          MyNumber = Trim(Str(MyNumber))

          ' Position of decimal place 0 if none.
          DecimalPlace = InStr(MyNumber, ".")
          ' Convert Centavos and set MyNumber to dollar amount.
          If DecimalPlace > 0 Then
              Centavos = 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 Pesos = Temp & Place(Count) & Pesos
              If Len(MyNumber) > 3 Then
                  MyNumber = Left(MyNumber, Len(MyNumber) - 3)
              Else
                  MyNumber = ""
              End If
              Count = Count + 1
          Loop

          Select Case Pesos
              Case ""
                  Pesos = "No Pesos"
              Case "One"
                  Pesos = "Un Peso"
              Case Else
                  Pesos = Pesos & " Pesos"
          End Select

          Select Case Centavos
              Case ""
                  Centavos = " y 00/100 Centavos"
              Case "One"
                  Centavos = " y Un Centavo"
              Case Else
                  Centavos = " y " & Centavos & " Centavos"
          End Select

          Letra = Pesos & Centavos
      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)) & " Ciento "
          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 = "Díez"
                  Case 11: Result = "Once"
                  Case 12: Result = "Doce"
                  Case 13: Result = "Trece"
                  Case 14: Result = "Catorce"
                  Case 15: Result = "Quince"
                  Case 16: Result = "Dieciséis"
                  Case 17: Result = "Diecisiete"
                  Case 18: Result = "Dieciocho"
                  Case 19: Result = "Diecinueve"
                  Case Else
              End Select
          Else                                 ' If value between 20-99...
              Select Case Val(Left(TensText, 1))
                  Case 2: Result = "Veinte "
                  Case 3: Result = "Treinta "
                  Case 4: Result = "Cuarenta "
                  Case 5: Result = "Cincuenta "
                  Case 6: Result = "Sesenta "
                  Case 7: Result = "Setenta "
                  Case 8: Result = "Ochenta "
                  Case 9: Result = "Noventa "
                  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 = "Un"
              Case 2: GetDigit = "Dos"
              Case 3: GetDigit = "Tres"
              Case 4: GetDigit = "Cuatro"
              Case 5: GetDigit = "Cinco"
              Case 6: GetDigit = "Seis"
              Case 7: GetDigit = "Siete"
              Case 8: GetDigit = "Ocho"
              Case 9: GetDigit = "Nueve"
              Case Else: GetDigit = ""
          End Select
      End Function

Buna suerte.
No full tested.
GUS

***NOTA: en un cell escribe...
=letra(45.00)
This message was edited by GUS on 2002-03-16 13:51
 
Upvote 0
Gus:

Gracias por tu ayuda, el programa funciona pero algunos numeros no los escribe correctamente por ejemplo 200 escribe "Dos Ciento pesos y 00/100" Centavos y debe poner "Doscientos pesos y cero centavos". Voy a tratar de hacer los cambios pero agradeceria me dijeras tu email para preguntarte las dudas que se me prsenten.

Gracias,

Hugo


Thanks for your help, it is working but needs some changes because some numbers doesn't spell it right. Per example if I write 200 it puts "Dos Ciento pesos y 00/100" Centavos and it should put "Doscientos pesos y cero centavos". I will try to make the changes but I will appreciate if you give me your email so I can ask you my doubts.

Hugo
This message was edited by huorsa on 2002-03-16 15:00
 
Upvote 0
Code:
Case ""
                  Centavos = " y 00/100 Centavos"
Cambialo a
Code:
Case ""
                  Centavos = " Cero Centavos"

hmmm voy a trabajar en los cientos ahora.. luego vuelvo....no habie notado eso.
This message was edited by GUS on 2002-03-16 19:48
 
Upvote 0

Forum statistics

Threads
1,213,482
Messages
6,113,915
Members
448,532
Latest member
9Kimo3

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top