Rutina de Numero a Texto! Saludos

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.

1 Respuesta

Respuesta
1
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
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
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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas