Numero cambiar a literal

Hola query:

1 Respuesta

Respuesta
1
Aquí te envio 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
SUERTE y que te sirva de ayuda.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas