CONVERTIR IMPORTE NUMERO A LETRA
Buen dia Amigo
Bueno mira estuve buscando entre mis cosillas viejas y encontre esto, recuerdo que lo saque de alguna pagina que ya no recuerdo donde:
Para llamarlo debe ser asi: WordNum(1500)
Copi y pega lo siguiente en tu aplicativo:
Private Function WordNum(ByVal Numero As String, Optional ByVal TipoCambioSingular As String = "", Optional ByVal TipoCambioPlural As String = "", Optional ByVal xInternal As Long = 0) As String
Dim sNum As String, vNum() As String, y As Long, Z As Long, sTmp As String, _
D1 As String, D2 As String, D3 As String, DFinal As String, tNum As String, B1 As Boolean, _
B2 As Boolean, B3 As Boolean, wNum() As String, Nombres() As String, glbSubS2 As String, _
glbSubP2 As String, glbSubS As String, glbSubP As String
Dim n As Integer? = Nothing
'**********************************************************************************************
'* Esta función convierte números en palabras, sin importar el contexto donde se encuentren *
'* Es capaz de procesar números de 123 dígitos (Vigintillones) :-O *
'* Solo se procesan 2 decimales si los hay *
'**********************************************************************************************
'Convierte el valor en un string
sNum = Trim(Replace(CStr(Numero), ",", "."))
'Procesa cada número que exista en la variable por separado
DFinal = ""
glbSubS2 = ""
glbSubS = ""
glbSubP = ""
glbSubP2 = ""
If xInternal = 0 Then
'Separa los números limpios de las palabras y los procesa por separado (no incluye números con letras)
wNum = Split(sNum, Space(1))
For x = 0 To UBound(wNum)
'Concatena los strings o números según corresponda
If IsNumeric(wNum(x)) Then
'Separa los enteros de los decimales para procesarlos por separado
If InStr(1, wNum(x), ".", vbTextCompare) > 0 Then
'Proceso los enteros
D1 = Microsoft.VisualBasic.Left(wNum(x), InStrRev(wNum(x), ".", , vbTextCompare) - 1)
DFinal = DFinal & IIf(D1 < 0, "menos ", "") & WordNum(D1, TipoCambioSingular, TipoCambioPlural, 1)
'Proceso 2 decimales
D2 = Mid(Mid(wNum(x), InStrRev(wNum(x), ".", , vbTextCompare) + 1), 1, 2)
If Val(D2) > 0 Then
If Microsoft.VisualBasic.Left(D2, 1) = "0" Then DFinal = DFinal & " con " & WordNum(D2, glbSubS2, glbSubP2, 1) & Space(1) Else DFinal = DFinal & " con " & WordNum(D2, glbSubS, glbSubP, 1) & Space(1)
End If
Else
DFinal = DFinal & IIf(wNum(x) < 0, "menos ", "") & WordNum(wNum(x), TipoCambioSingular, TipoCambioPlural, 1) & Space(1)
End If
Else
DFinal = DFinal & wNum(x) & Space(1)
End If
Next
Else
'Elimina el signo
If Not IsNumeric(Microsoft.VisualBasic.Left(sNum, 1)) Then
sNum = Mid(sNum, 2)
End If
'Elimina cualquier formato posible (incluye valores científicos)
'sNum = Format(sNum, "0")
If sNum = vbNullString Then sNum = "0"
'Completa con ceros a la izquierda hasta obtener una longitud múltiplo de 3
Do While Len(sNum) Mod 3 <> 0
sNum = "0" & sNum
Loop
'Dimenciona un arreglo con espacio para cada una de las centenas
ReDim vNum(Len(sNum) / 3 - 1)
'Carga el arreglo con las centenas que corresponda
For x = 0 To UBound(vNum, 1)
vNum(x) = Mid(sNum, (x + 1) * 3 - 2, 3)
Next
'Si el arreglo contiene una sola centena, la convierte en palabras
If UBound(vNum, 1) = 0 Then
'Asigna los dígitos de la centena y recuerda si son mayores que cero
D3 = Microsoft.VisualBasic.Left(sNum, 1) : B3 = Val(D3) > 0
D2 = Mid(sNum, 2, 1) : B2 = Val(D2) > 0
D1 = Microsoft.VisualBasic.Right(sNum, 1) : B1 = Val(D1) > 0
'Procesa las unidades
Select Case D1
Case "1" : DFinal = "un"
Case "2" : DFinal = "dos"
Case "3" : DFinal = "tres"
Case "4" : DFinal = "cuatro"
Case "5" : DFinal = "cinco"
Case "6" : DFinal = "seis"
Case "7" : DFinal = "siete"
Case "8" : DFinal = "ocho"
Case "9" : DFinal = "nueve"
End Select
'Procesa las decenas
Select Case D2
Case "1"
'Maneja lógica del retrasado mental que puso nombres ilógicos a algunos números.
Select Case D1
Case "0" : DFinal = "diez"
Case "1" : DFinal = "once" 'dieciuno
Case "2" : DFinal = "doce" 'diecidos
Case "3" : DFinal = "trece" 'diecitres
Case "4" : DFinal = "catorce" 'diecicuatro
Case "5" : DFinal = "quince" 'diecicinco
Case "6" : DFinal = "dieciséis" 'acento :(
Case Else
DFinal = "dieci" & DFinal
End Select
Case "2"
If B1 Then
If D1 = "2" Then DFinal = "dós"
If D1 = "3" Then DFinal = "trés"
DFinal = "veinti" & DFinal
Else
DFinal = "veinte"
End If
Case "3" : If B1 Then DFinal = "treinta y " & DFinal Else DFinal = "treinta"
Case "4" : If B1 Then DFinal = "cuarenta y " & DFinal Else DFinal = "cuarenta"
Case "5" : If B1 Then DFinal = "cincuenta y " & DFinal Else DFinal = "cincuenta"
Case "6" : If B1 Then DFinal = "sesenta y " & DFinal Else DFinal = "sesenta"
Case "7" : If B1 Then DFinal = "setenta y " & DFinal Else DFinal = "setenta"
Case "8" : If B1 Then DFinal = "ochenta y " & DFinal Else DFinal = "ochenta"
Case "9" : If B1 Then DFinal = "noventa y " & DFinal Else DFinal = "noventa"
End Select
'Procesa las centenas
Select Case D3
Case "1" : If B1 Or B2 Then DFinal = "ciento " & DFinal Else DFinal = "cien"
Case "2" : If B1 Or B2 Then DFinal = "doscientos " & DFinal Else DFinal = "doscientos"
Case "3" : If B1 Or B2 Then DFinal = "trescientos " & DFinal Else DFinal = "trescientos"
Case "4" : If B1 Or B2 Then DFinal = "cuatrocientos " & DFinal Else DFinal = "cuatrocientos"
Case "5" : If B1 Or B2 Then DFinal = "quinientos " & DFinal Else DFinal = "quinientos"
Case "6" : If B1 Or B2 Then DFinal = "seiscientos " & DFinal Else DFinal = "seiscientos"
Case "7" : If B1 Or B2 Then DFinal = "setecientos " & DFinal Else DFinal = "setecientos"
Case "8" : If B1 Or B2 Then DFinal = "ochocientos " & DFinal Else DFinal = "ochocientos"
Case "9" : If B1 Or B2 Then DFinal = "novecientos " & DFinal Else DFinal = "novecientos"
End Select
'Si es la ejecución principal efectua algunos arreglines
If xInternal = 1 Then
'Validación del cero
If IsDBNull(Trim(DFinal)) = 0 Then DFinal = "cero"
'Validación de terminados en "un"
If Microsoft.VisualBasic.Right(DFinal, 2) = "un" And Len(TipoCambioSingular) = 0 Then DFinal = DFinal & "o"
End If
Else 'Si es más de una centena, las separa y procesa independientemente
y = -1
Z = 1
For x = UBound(vNum) To 0 Step -1
y = y + 1
'Convierte la centena en palabras
tNum = WordNum(vNum(x), xInternal:=2)
'Arregla la terminación "uno" cuando corresponde
If y = 0 And Microsoft.VisualBasic.Right(tNum, 2) = "un" And TipoCambioSingular & TipoCambioPlural = "" Then tNum = tNum + "o"
'Genera un valor temporal para poder modificar
sTmp = tNum
'Asigna los nombres genéricos principales
Nombres = Split(" mil , millón , millones , billón , billones , trillón , trillones , cuatrillón , cuatrillones , quintillón , quintillones , sextillón , sextillones , septillón , septillones , octillón , octillones , nonillón , nonillones , decillón , decillones , undecillón , undecillones , duodecillón , duodecillones , tredecillón , tredecillones , cuatordecillón , cuatordecillones , quindecillón , quindecillones , sexdecillón , sexdecillones , septendecillón , septendecillones , octodecillón , octodecillones , novendecillón , novendecillones , vigintillón , vigintillones ", ",")
'Controla que el índice de nombres no salga de los límites
If y > UBound(Nombres) Then
WordNum = "?"
Exit Function
End If
'Asigna los nombres correspondientes
If y Mod 2 > 0 Then
D1 = Nombres(0)
D2 = Nombres(y - 1)
ElseIf y > 0 Then
D1 = Nombres(y - 1)
D2 = Nombres(y)
Else
D1 = "" : D2 = ""
End If
'Actualiza el nombre del número
Select Case y Mod 2
Case 0 : If sTmp = "un" Then sTmp = sTmp & D1 Else sTmp = sTmp & IIf(tNum = "", "", D2)
Case Else
If sTmp = "un" Then sTmp = ""
sTmp = sTmp & IIf(tNum = "", "", D1)
If x = 0 And y > 1 Then
If InStr(1, DFinal, D2, vbTextCompare) = 0 Then sTmp = sTmp & Mid(D2, 2)
End If
End Select
DFinal = sTmp & DFinal
Next
End If
End If
'Aplica el tipo de moneda cuando corresponda
If xInternal = 1 Then DFinal = DFinal & Space(1) & IIf(Format(sNum, "#0") = "1", TipoCambioSingular, TipoCambioPlural)
'Asigna el número en palabras
WordNum = Trim(DFinal)
End Function
