Buenas..
Alguien me ayuda con esto, que por ejemplo en un texto este una cantidad cualquiera en números y en un label o otro texto se muestre dicha cantidad pero en letras. Espero me entiendan.
Tendrás que hacerte tu el algoritmo...
Aunque por ahí he visto ya hechos... :rolleyes:
Freddy, pega esto en un Modulo Bas...
Function MontoEscrito(Monto As Currency) As String
Dim AMT As String
Dim n As String
Dim m As String
Dim k As String
Dim L As String
Dim Rtn_String As String * 120
n = "Un Dos Tres CuatroCinco Seis Siete Ocho Nueve "
m = "Diez Once Doce Trece Catorce Quince Dieciseis DiecisieteDieciocho Diecinueve"
k = "Veinte Treinta Cuarenta CincuentaSesenta Setenta Ochenta Noventa "
L = "Cien Doscientos Trescientos CuatrocientosQuinientos Seiscientos Setecientos Ochocientos Novecientos "
If Monto = 0 Then
MontoEscrito = ""
Exit Function
End If
AMT = Format(Monto, "000000000.00")
Rtn_String = ""
If Mid(AMT, 1, 1) = 1 Then ' 100 - 900 MILLONES
Rtn_String = Trim(Mid(L, ((Mid(AMT, 1, 1) - 1) * 13) + 1, 13))
If Trim(Mid(AMT, 1, 3)) > "100" Then
Rtn_String = Trim(Rtn_String) & "to"
End If
ElseIf Mid(AMT, 1, 1) > 1 Then
Rtn_String = Trim(Mid(L, ((Mid(AMT, 1, 1) - 1) * 13) + 1, 13))
End If
If Mid(AMT, 2, 1) = 1 Then ' 10 - 99 MILLONES
Rtn_String = Trim(Rtn_String) & " " & Mid(m, (Mid(AMT, 3, 1) * 10) + 1, 10)
ElseIf Mid(AMT, 2, 1) > 1 Then
Rtn_String = Trim(Rtn_String) & " " & Mid(k, ((Mid(AMT, 2, 1) - 2) * 9) + 1, 9)
If Mid(AMT, 3, 1) > 0 Then
Rtn_String = Trim(Rtn_String) & " y " & Mid(n, ((Mid(AMT, 3, 1) - 1) * 6) + 1, 6)
End If
ElseIf Mid(AMT, 3, 1) > 0 Then ' 1 - 9 MILLONES
Rtn_String = Trim(Rtn_String) & " " & Mid(n, ((Mid(AMT, 3, 1) - 1) * 6) + 1, 6)
End If
If Trim(Rtn_String) <> "" Then
If Mid(AMT, 1, 3) > 1 Then
Rtn_String = Trim(Rtn_String) & " Millones "
Else
Rtn_String = Trim(Rtn_String) & " Millón "
End If
End If
If Mid(AMT, 4, 1) = 1 Then ' 100 - 900 MIL
Rtn_String = Trim(Rtn_String) & " " & Trim(Mid(L, ((Mid(AMT, 4, 1) - 1) * 13) + 1, 13))
If Mid(AMT, 4, 3) > "100" Then
Rtn_String = Trim(Rtn_String) & "to"
End If
ElseIf Mid(AMT, 4, 1) > 1 Then
Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 4, 1) - 1) * 13) + 1), 13)
End If
If Mid(AMT, 5, 1) = 1 Then ' 10 - 19 Miles
Rtn_String = Trim(Rtn_String) & " " & Mid(m, (((Mid(AMT, 6, 1)) * 10) + 1), 10)
ElseIf Mid(AMT, 5, 1) > 1 Then ' 20 - 99 Miles
Rtn_String = Trim(Rtn_String) & " " & Mid(k, (((Mid(AMT, 5, 1) - 2) * 9) + 1), 9)
If Mid(AMT, 6, 1) > 0 Then ' 2? - 9? Miles
Rtn_String = Trim(Rtn_String) & " y " & Mid(n, (((Mid(AMT, 6, 1) - 1) * 6) + 1), 6)
End If
ElseIf Mid(AMT, 6, 1) > 0 Then ' 1 - 9 Miles
Rtn_String = Trim(Rtn_String) & " " & Mid(n, (((Mid(AMT, 6, 1) - 1) * 6) + 1), 6)
End If
If Mid(AMT, 1, 6) <> "000000" And Mid(AMT, 4, 3) <> "000" Then
Rtn_String = Trim(Rtn_String) & " Mil "
End If
If Mid(AMT, 7, 1) = 1 Then
Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 7, 1) - 1) * 13) + 1), 13)
If Trim(Mid(AMT, 7, 3)) > "100" Then
Rtn_String = Trim(Rtn_String) & "to"
End If
ElseIf Mid(AMT, 7, 1) > 1 Then
Rtn_String = Trim(Rtn_String) & " " & Mid(L, (((Mid(AMT, 7, 1) - 1) * 13) + 1), 13)
End If
If Mid(AMT, 8, 1) = 1 Then
Rtn_String = Trim(Rtn_String) & " " & Mid(m, ((Mid(AMT, 9, 1) * 10) + 1), 10)
ElseIf Mid(AMT, 8, 1) > 1 Then
Rtn_String = Trim(Rtn_String) & " " & Mid(k, (((Mid(AMT, 8, 1) - 2) * 9) + 1), 9)
If Mid(AMT, 9, 1) > 0 Then
Rtn_String = Trim(Rtn_String) & " y " & Mid(n, (((Mid(AMT, 9, 1) - 1) * 6) + 1), 6)
End If
ElseIf Mid(AMT, 9, 1) > 0 Then
Rtn_String = Trim(Rtn_String) & " " & Trim(Mid(n, (((Mid(AMT, 9, 1) - 1) * 6) + 1), 6))
If Mid(AMT, 9, 1) = 1 Then
Rtn_String = Trim(Rtn_String) & "o"
End If
End If
If Trim(Rtn_String) <> "" Then
Rtn_String = Trim(Rtn_String) & " con "
End If
Rtn_String = Trim(Rtn_String) & " " & Mid(AMT, 11, 2) & "/100"
MontoEscrito = Rtn_String
End Function
Y para mostrarlo...
Label1.Caption = MontoEscrito(CCur(Text1.Text))
Si alguien tiene una mejor manera de hacerlo, pues se aceptan aportes... Saludos
Gracia Miguel. Funciona del carajo. ;-)
Haber si te sirve este es un ocx
Descarga (http://www.megaupload.com)
Megaupload
Descarga
Cita de: GhostLT en 17 Febrero 2010, 16:39 PM
Haber si te sirve este es un ocx
Descarga (http://www.megaupload.com)
Megaupload
Descarga
La intención es no usar dependencias.... :silbar:
Gracias por el modulo SSCCAANN43, creo que me servirá, estas respuestas no se obtienen el todos lo portales, digo en todos los foros... tal vez algunos users de este foro deberian visitar otros portales, digo foros (me equivoqué otra vez) y corregir algunos Horrores, digo errores... no ?
Aqui esta corregido el link freddyjose00
(http://www.megaupload.com/?d=RKVANBCE)
Cita de: Hasseds en 17 Febrero 2010, 16:48 PM
Gracias por el modulo SSCCAANN43, creo que me servirá, estas respuestas no se obtienen el todos lo portales, digo en todos los foros... tal vez algunos users de este foro deberian visitar otros portales, digo foros (me equivoqué otra vez) y corregir algunos Horrores, digo errores... no ?
De nada, la idea es aportar y brindar apoyo a los demas usuarios...!
Cita de: ssccaann43 en 17 Febrero 2010, 16:56 PM
De nada, la idea es aportar y brindar apoyo a los demas usuarios...!
+1