Rutina de Numero a Texto! Saludos

Respuesta de
a
Usuario
Gracias de antemano por el tiempo.
Tal ves ya la haz dado pero no la he encontrado solo que un reporte y en un formulario la necesito en un campo independiente ya que cuando me saca el total que es la suma de todos registros del costo de productos me salga la cantidad con letra y el formato de centavos también (85.50 Ochenta y cinco pesos 50/100 .m.n)
Espero tu pronta respuesta saludos y gracias.
Experto
Tengo una función llamada
NumerosEurosALetras
Que funciona así:
numerosEurosAletras("8.50", false,"peso","centavos")-> te devuelve
ocho pesos con 50 centavos.

("8.50", false,"peso","/100 m.n")-> te devuelve
8 pesos con 50/100 m.n.es"

¿Te vale?
(Por favor se más claro la próxima vez)

Te adjunto el código. Pégalo en un nuevo modulo. En la primera linea, pon el separador decimal que usa tu sistema.

'--codigo--
Const ct_separador_decimal = "."
Public Function NumerosEurosALetras(ByVal NumberStr As String, Optional lFemenino = False, Optional cMoneda = "euro", Optional cCentimos = "céntimo") As String
Dim nTemp, nDecimales
nTemp = InStr(NumberStr, ct_separador_decimal)
If nTemp = 0 Then
NumerosEurosALetras = NumerosALetras(NumberStr, lFemenino, cMoneda)
Else
nDecimales = Len(Mid(NumberStr, nTemp + 1))
Select Case nDecimales
Case 0
NumerosEurosALetras = NumerosALetras(NumberStr, lFemenino, cMoneda)
Case 1, 2 'centimos'
If nDecimales = 1 Then
NumberStr = NumberStr & "0"
End If
NumerosEurosALetras = NumerosALetras(Left(NumberStr, nTemp - 1), lFemenino, cMoneda) & " con" & _
NumerosALetras(Mid(NumberStr, nTemp + 1), lFemenino, cCentimos)
Case Else
NumerosEurosALetras = NumerosALetras(Left(NumberStr, nTemp - 1), False) & " coma " & _
NumerosALetras(Mid(NumberStr, nTemp + 1), False) & " " & cMoneda & _
IIf(InStr("aeio", Right(cMoneda, 1)) = 0, "e", "") & "s"

End Select
End If

End Function




Public Function NumerosALetras(ByVal NumberStr As String, Optional lFemenino = True, Optional cMoneda = "") As String

Dim z As String, x As String, Temp As String, c As String
Dim a As Integer, b As Integer, i As Integer
Dim iPos As Integer
Dim data(9, 3) As String


data(0, 0) = "uno"
data(1, 0) = "dos"
data(2, 0) = "tres"
data(3, 0) = "cuatro"
data(4, 0) = "cinco"
data(5, 0) = "seis"
data(6, 0) = "siete"
data(7, 0) = "ocho"
data(8, 0) = "nueve"
data(9, 0) = "diez"
data(0, 1) = "cien"
data(1, 1) = "diez"
data(2, 1) = "veinte"
data(3, 1) = "treinta"
data(4, 1) = "cuarenta"
data(5, 1) = "cincuenta"
data(6, 1) = "sesenta"
data(7, 1) = "setenta"
data(8, 1) = "ochenta"
data(9, 1) = "noventa"
data(0, 3) = "diez"
data(1, 3) = "once"
data(2, 3) = "doce"
data(3, 3) = "trece"
data(4, 3) = "catorce"
data(5, 3) = "quince"
data(6, 3) = "dieciséis"
data(7, 3) = "diecisiete"
data(8, 3) = "dieciocho"
data(9, 3) = "diecinueve"


'remove redundant spaces
'NumberStr = Trim( Replace(NumberStr, ",", ""))
NumberStr = Trim(NumberStr)
a = Len(NumberStr)
Temp = NumberStr
If Val(NumberStr) = 0 Then
NumerosALetras = "cero"
Exit Function
End If

'get rid of any decimals
iPos = InStr(Temp, ct_separador_decimal)
If iPos > 0 Then Temp = Left(Temp, iPos - 1)

While ((a Mod 3) <> 0)
Temp = "0" & Temp
a = Len(Temp)
Wend

NumberStr = Temp

For i = a - 2 To 1 Step -3
b = b + 1
Temp = Mid(NumberStr, i, 3)
z = ""
' "Intelligent" routines
'------------------------
If Temp <> "000" Then
If Temp = "100" Then
z = "cien"
Else
c = Left(Temp, 1)
If c <> "0" Then
If c = "1" Then
z = "ciento"
ElseIf c = "5" Then
z = " quinientos"
ElseIf c = "7" Then
z = " setecientos"
ElseIf c = "9" Then
z = " novecientos"
Else
z = " " & data(Val(c) - 1, 0) & "cientos"
End If
End If
c = Mid(Temp, 2, 1)
If c <> "0" Then
If c <> "1" Then
z = z & " " & data(Val(c), 1)
Else
z = z & " " & data(Val(Right(Temp, 2)) - 10, 3)
End If
End If
End If
If Right(Temp, 1) <> "0" And Mid(Temp, 2, 1) <> "1" Then

z = z & IIf(z = "", "", " y ") & data(Val(Right(Temp, 1)) - 1, 0)
End If
End If
'------------------------
If z <> "" Then
Select Case b
Case 1:
x = z
Case 2:
If z = "uno" Then
x = "mil" & x
Else
x = z & " mil" & x
End If
Case 3:
If z = "uno" Then
x = "un millón " & x
Else
x = z & " millones " & x
End If
Case 4:
If z = "uno" Then
x = "mil millones " & x
Else
x = z & " mil millones " & x
End If
Case 5:
If z = "uno" Then
x = "un billón " & x
Else
x = z & " billones " & x
End If
Case Else:
Exit Function
End Select
End If
Next

'correción de genero
If x = "uno" Then
x = IIf(lFemenino, "una", "un")
ElseIf Right(x, 3) = "uno" Then
x = Mid(x, 1, Len(x) - 3) & IIf(lFemenino, "una", IIf(cMoneda = "", "uno", "un"))
ElseIf Right(x, 3) = "tos" And lFemenino Then
x = Mid(x, 1, Len(x) - 3) & "tas"
End If
If cMoneda <> "" Then
x = x & " " & IIf(Val(NumberStr) <= 1, cMoneda, cMoneda & IIf(InStr("aeio", Right(cMoneda, 1)) = 0, "e", "") & "s")
End If
NumerosALetras = x


End Function
Usuario
Y perdón por no se tan explicito solo necesito que en un cuadro de texto me ponga la cantidad con letra utilizando el formato con centavos de mexico ya que es el país donde vivo. Por Ejep.
$85.50 que ponga.
Ochenta y cinco pesos 50/100 m.n.
La rutina que me enviaste me lo saca en cambio de letras pero esta en Euros.
¿Tienes la de pesos mexicanos?
Gracias y cuidate
Experto
Te adjunto la rutina para pasar a centavos de mexico.
Pégala con el resto del código.
Para usarla pon
= pesosALetrAs("8,50")
Ocho pesos 50/100 m.n.

Te recuerdo que tienes que
Ajustar la coma.

Const ct_separador_decimal = "."


´----------------


Public Function PesosALetras(ByVal NumberStr As String) As String
Dim nTemp, nDecimales
nTemp = InStr(NumberStr, ct_separador_decimal)
If nTemp = 0 Then
PesosALetras = NumerosALetras(NumberStr, False, "peso")
Else
nDecimales = Len(Mid(NumberStr, nTemp + 1))
Select Case nDecimales
Case 0
PesosALetras = NumerosALetras(NumberStr, False, "peso")
Case 1, 2 'centimos'
If nDecimales = 1 Then
NumberStr = NumberStr & "0"
End If
PesosALetras = NumerosALetras(Left(NumberStr, nTemp - 1), False, "peso") & " " & Mid(NumberStr, nTemp + 1) & "/100 m.n."
End Select
End If

End Function
Usuario
Mil gracias por tu tiempo y excelente conocimientos.
Suerte