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
Autor
En línea
