De números a letras con centavos

Hola Andi
Mirá encontré esto en todo expertos. Es una consulta que contesta un experto a una pregunta similar a la estuvimos viendo. El usuario también tuvo el problema de los centavos y más abajo el experto le dice que tiene que anular una función y reemplazarla por otra que adjunta más abajo.
Abuso de tu amabilidad (y si tenes algo de tiempo) para ver si tu puedes hacer el reemplazo y enviármela como debería ser. Yo sigo con el temos de eliminar algo que sirva y luego no poder dar marcha atrás.
Desde ya te prometo que no vuelvo más con este tema.
Muchas Gracias por toda tu atención.
"Aquí te envío un módulo con tres procedimientos de los que sólo tendrás que utilizar la función abcednum indicándole el número y el género del número (masculino, femenino o neutro)

Option Compare Database 'Usar orden de base de datos en comparaciones de cadenas
Option Explicit
Global G_Genero_Numero As String
Global Const NUM_FEM = 0
Global Const NUM_MAS = 1
Global Const NUM_NEU = 2
Function abcednum(Num, lang As String) As String
G_Genero_Numero = lang
Select Case lang
Case "es", "esf"
abcednum = n2t_tbs_es(Num, NUM_FEM)
Case "esm"
abcednum = n2t_tbs_es(Num, NUM_MAS)
Case "esn"
abcednum = n2t_tbs_es(Num, NUM_NEU)
Case Else
abcednum = n2t_tbs_es(Num, NUM_FEM)
G_Genero_Numero = "es"
End Select
End Function
Function n2t_tbs_es(Num, sexo) As String
Dim abnum As Long, _
txt As String, _
xt As String
If Abs(Fix(Num)) > 999999999 Then
n2t_tbs_es = "Excedido valor soportado."
Exit Function
End If
abnum = Abs(Fix(Num))
xt = Right$(Format$(Fix(abnum / 1000000), "000"), 3)
If Val(xt) <> 0 Then txt = n2t_tbs_es_f(1, xt, sexo)
xt = Right$(Format$(Fix(abnum / 1000), "000"), 3)
If Val(xt) <> 0 Then txt = txt & n2t_tbs_es_f(2, xt, sexo)
xt = Right$(Format$(abnum, "000"), 3)
If Val(xt) <> 0 Then txt = txt & n2t_tbs_es_f(3, xt, sexo)
n2t_tbs_es = txt
End Function
Function n2t_tbs_es_f(n As Integer, cf As String, sexo) As String
' sexo: 0=femenino, 1=masculino, 2=masculino terminado en UN
Static cf1(16) As String, cf2(10) As String, cf3(10) As String, sw As Integer
Dim ftxt As String
If sw = 0 Then
cf1(1) = "UNA"
cf1(2) = "DOS"
cf1(3) = "TRES"
cf1(4) = "CUATRO"
cf1(5) = "CINCO"
cf1(6) = "SEIS"
cf1(7) = "SIETE"
cf1(8) = "OCHO"
cf1(9) = "NUEVE"
cf1(10) = "DIEZ"
cf1(11) = "ONCE"
cf1(12) = "DOCE"
cf1(13) = "TRECE"
cf1(14) = "CATORCE"
cf1(15) = "QUINCE"
cf2(1) = "DIECI"
cf2(2) = "VEINTI"
cf2(3) = "TREINTA"
cf2(4) = "CUARENTA"
cf2(5) = "CINCUENTA"
cf2(6) = "SESENTA"
cf2(7) = "SETENTA"
cf2(8) = "OCHENTA"
cf2(9) = "NOVENTA"
cf3(1) = "CIENTO"
cf3(2) = "DOS"
cf3(3) = "TRES"
cf3(4) = "CUATRO"
cf3(5) = "QUINIEN"
cf3(6) = "SEIS"
cf3(7) = "SETE"
cf3(8) = "OCHO"
cf3(9) = "NOVE"
sw = 1
End If
If sexo = 0 Then cf1(1) = "UNA" Else If n = 3 And sexo = 1 Then cf1(1) = "UNO" Else cf1(1) = "UN"
If Val(cf) = 1 And n = 2 Then GoTo sx4_n2t_tbs_es
If Mid$(cf, 1, 1) = "0" Then GoTo sx2_n2t_tbs_es
If Val(cf) = 100 Then ftxt = "CIEN": GoTo sx4_n2t_tbs_es
ftxt = cf3(Val(Mid$(cf, 1, 1)))
Select Case Val(Mid$(cf, 1, 1))
Case 1
ftxt = ftxt & " ": GoTo sx2_n2t_tbs_es
Case 2 To 4, 6 To 9
ftxt = ftxt & "CIEN"
End Select
If n > 1 And sexo = 0 Then
ftxt = ftxt & "TAS "
Else
ftxt = ftxt & "TOS "
End If
sx2_n2t_tbs_es:
Select Case Val(Mid$(cf, 2))
Case 10
ftxt = ftxt & "DIEZ "
Case 2 To 15
ftxt = ftxt & cf1(Val(Mid$(cf, 2)))
Case 20
ftxt = ftxt & "VEINTE "
Case Else
If Val(Mid$(cf, 2, 1)) > 0 Then ftxt = ftxt & cf2(Val(Mid$(cf, 2, 1)))
If Val(Mid$(cf, 2, 1)) > 2 Then
If Val(Mid$(cf, 3, 1)) = 0 Then GoTo sx4_n2t_tbs_es
ftxt = ftxt & " Y "
End If
If n = 1 And Mid$(cf, 3, 1) = "1" Then
ftxt = ftxt & "UN"
ElseIf Val(Mid$(cf, 3, 1)) > 0 Then
ftxt = ftxt & cf1(Val(Mid$(cf, 3, 1)))
End If
End Select
sx4_n2t_tbs_es:
Select Case n
Case 1
Select Case Val(cf)
Case 1
ftxt = ftxt & " MILLON "
Case Is > 1
ftxt = ftxt & " MILLONES "
End Select
Case 2
ftxt = ftxt & " MIL "
End Select
n2t_tbs_es_f = ftxt
End Function
Sustituye la antigua función adcdenum del módulo que creaste por esta nueva que trata la parte decimal como me estas comentando.

Function abcednum(Num, lang As String) As String
Dim sNumero As String
Dim sN As String
Dim lPosDecimal As Integer
G_Genero_Numero = lang
Select Case lang
Case "es", "esf"
sNumero = n2t_tbs_es(Num, NUM_FEM)
Case "esm"
sNumero = n2t_tbs_es(Num, NUM_MAS)
Case "esn"
sNumero = n2t_tbs_es(Num, NUM_NEU)
Case Else
sNumero = n2t_tbs_es(Num, NUM_FEM)
G_Genero_Numero = "es"
End Select
Dim sDecimal As String * 1
' Averiguar el signo decimal
sN = Format$(25.5, "#.#")
If InStr(sN, ".") Then
sDecimal = "."
Else
sDecimal = ","
End If
' Convierte a texto el nº y obtiene la parte decimal
sN = Format(Num, "#.##")
lPosDecimal = InStr(sN, sDecimal)
' Si hay decimales los muestra con el formato de México
If lPosDecimal Then
sN = Mid$(sN, lPosDecimal + 1, 2)
sNumero = sNumero & "pesos " & sN & "/100 m.n."
End If
abcednum = sNumero
End Function
Respuesta
1
sNumero = n2t_tbs_es(Num, NUM_NEU)
Case Else
sNumero = n2t_tbs_es(Num, NUM_FEM)
G_Genero_Numero = "es"
End Select
Dim sDecimal As String * 1
' Averiguar el signo decimal
sN = Format$(25.5, "#.#")
If InStr(sN, ".") Then
sDecimal = "."
Else
sDecimal = ","
End If
' Convierte a texto el nº y obtiene la parte decimal
sN = Format(Num, "#.##")
lPosDecimal = InStr(sN, sDecimal)
' Si hay decimales los muestra con el formato de México
If lPosDecimal Then
sN = Mid$(sN, lPosDecimal + 1, 2)
sNumero = sNumero & "pesos " & sN & "/100 m.n."
End If
abcednum = sNumero
End Function
Function n2t_tbs_es(Num, sexo) As String
Dim abnum As Long, _
txt As String, _
xt As String
If Abs(Fix(Num)) > 999999999 Then
n2t_tbs_es = "Excedido valor soportado."
Exit Function
End If
abnum = Abs(Fix(Num))
xt = Right$(Format$(Fix(abnum / 1000000), "000"), 3)
If Val(xt) <> 0 Then txt = n2t_tbs_es_f(1, xt, sexo)
xt = Right$(Format$(Fix(abnum / 1000), "000"), 3)
If Val(xt) <> 0 Then txt = txt & n2t_tbs_es_f(2, xt, sexo)
xt = Right$(Format$(abnum, "000"), 3)
If Val(xt) <> 0 Then txt = txt & n2t_tbs_es_f(3, xt, sexo)
n2t_tbs_es = txt
End Function
Function n2t_tbs_es_f(n As Integer, cf As String, sexo) As String
' sexo: 0=femenino, 1=masculino, 2=masculino terminado en UN
Static cf1(16) As String, cf2(10) As String, cf3(10) As String, sw As Integer
Dim ftxt As String
If sw = 0 Then
cf1(1) = "UNA"
cf1(2) = "DOS"
cf1(3) = "TRES"
cf1(4) = "CUATRO"
cf1(5) = "CINCO"
cf1(6) = "SEIS"
cf1(7) = "SIETE"
cf1(8) = "OCHO"
cf1(9) = "NUEVE"
cf1(10) = "DIEZ"
cf1(11) = "ONCE"
cf1(12) = "DOCE"
cf1(13) = "TRECE"
cf1(14) = "CATORCE"
cf1(15) = "QUINCE"
cf2(1) = "DIECI"
cf2(2) = "VEINTI"
cf2(3) = "TREINTA"
cf2(4) = "CUARENTA"
cf2(5) = "CINCUENTA"
cf2(6) = "SESENTA"
cf2(7) = "SETENTA"
cf2(8) = "OCHENTA"
cf2(9) = "NOVENTA"
cf3(1) = "CIENTO"
cf3(2) = "DOS"
cf3(3) = "TRES"
cf3(4) = "CUATRO"
cf3(5) = "QUINIEN"
cf3(6) = "SEIS"
cf3(7) = "SETE"
cf3(8) = "OCHO"
cf3(9) = "NOVE"
sw = 1
End If
If sexo = 0 Then cf1(1) = "UNA" Else If n = 3 And sexo = 1 Then cf1(1) = "UNO" Else cf1(1) = "UN"
If Val(cf) = 1 And n = 2 Then GoTo sx4_n2t_tbs_es
If Mid$(cf, 1, 1) = "0" Then GoTo sx2_n2t_tbs_es
If Val(cf) = 100 Then ftxt = "CIEN": GoTo sx4_n2t_tbs_es
ftxt = cf3(Val(Mid$(cf, 1, 1)))
Select Case Val(Mid$(cf, 1, 1))
Case 1
ftxt = ftxt & " ": GoTo sx2_n2t_tbs_es
Case 2 To 4, 6 To 9
ftxt = ftxt & "CIEN"
End Select
If n > 1 And sexo = 0 Then
ftxt = ftxt & "TAS "
Else
ftxt = ftxt & "TOS "
End If
sx2_n2t_tbs_es:
Select Case Val(Mid$(cf, 2))
Case 10
ftxt = ftxt & "DIEZ "
Case 2 To 15
ftxt = ftxt & cf1(Val(Mid$(cf, 2)))
Case 20
ftxt = ftxt & "VEINTE "
Case Else
If Val(Mid$(cf, 2, 1)) > 0 Then ftxt = ftxt & cf2(Val(Mid$(cf, 2, 1)))
If Val(Mid$(cf, 2, 1)) > 2 Then
If Val(Mid$(cf, 3, 1)) = 0 Then GoTo sx4_n2t_tbs_es
ftxt = ftxt & " Y "
End If
If n = 1 And Mid$(cf, 3, 1) = "1" Then
ftxt = ftxt & "UN"
ElseIf Val(Mid$(cf, 3, 1)) > 0 Then
ftxt = ftxt & cf1(Val(Mid$(cf, 3, 1)))
End If
End Select
sx4_n2t_tbs_es:
Select Case n
Case 1
Select Case Val(cf)
Case 1
ftxt = ftxt & " MILLON "
Case Is > 1
ftxt = ftxt & " MILLONES "
End Select
Case 2
ftxt = ftxt & " MIL "
End Select
n2t_tbs_es_f = ftxt
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas