Visual Basic.NET - CONVERTIR IMPORTE NUMERO A LETRA

   
Vista:
Imágen de perfil de RUBEN

CONVERTIR IMPORTE NUMERO A LETRA

Publicado por RUBEN piscis7003@hotmail.com (3 intervenciones) el 25/05/2013 19:28:56
HOLA BUENOS DIAS, SOLITO SU AYUDA PARA PODER GENEAR CODIGO QUE ME CONVIERTA IMPORTE NUMERO A IMPORTE LETRA, ESTOY ELABORANDO EN MI TRABAJO UN CONTROL DE PAGO DE ALIMENTOS AL PERSONAL QUE NO HACE USO DEL COMEDOR POR DIFERENTES AUSENCIAS, DE MANERA QUE DOS VECES AL MES SE SOLICITA AL ADMINISTRADOR DEL COMEDOR LA DEVOLUCION DEL IMPORTE DEL PERSONAL QUE NO HIZO USO DEL COMEDOR, PERO NO TENGO IDEA DE COMO REALIZARLO, SI PUDIERAN AYUDARME AUNQUE SEA CON UN ALGORITMO PARA ASI YO MISMO PODER DESARROLLARLO O SI NO ES MUCHA MOLESTIA UN CODIGO QUE ME GUIE PARA TAL FIN, SE LOS AGRADEZCO DE ANTEMANO.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

CONVERTIR IMPORTE NUMERO A LETRA

Publicado por El Viejo Charles (7 intervenciones) el 07/06/2013 20:44:59
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
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de RUBEN

CONVERTIR IMPORTE NUMERO A LETRA

Publicado por RUBEN piscis7003@hotmail.com (3 intervenciones) el 08/06/2013 05:38:47
Hola Buenas noches Viejo charles, eres muy amable en proporcionarme este código para introducirlo y ejecutarlo, espero seguir en contacto contigo y con todos los del foro, en tanto cuídate y gracias nuevamente....Ruben Mb.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar