1
« en: Viernes 6 de Agosto de 2004, 18:47 »
Function NumToWord(NumVal, WMoneda) As String
On Error GoTo NumToWord_Err
Dim NTW, NText, Dollars, Cents, NWord, TotalCents As String
Dim DecPlace, TotalSets, cnt, LDollHold As Integer
ReDim NumParts(9) As String
ReDim Place(9) As String
Dim LDoll As Integer
Place(2) = " Mil "
Place(3) = " Millón "
Place(4) = " Billón "
Place(5) = " Trillón "
NTW = ""
NText = Trim(Str(NumVal))
DecPlace = InStr(Trim(NText), ".")
Dollars = Trim(Left(NText, IIf(DecPlace = 0, Len(NumVal), DecPlace - 1)))
LDoll = Len(Dollars)
Cents = Trim(Right(NText, IIf(DecPlace = 0, 0, Abs(DecPlace - Len(NText)))))
If Len(Cents) = 1 Then
Cents = Cents & "0"
End If
If (LDoll Mod 3) = 0 Then
TotalSets = (LDoll \ 3)
Else
TotalSets = (LDoll \ 3) + 1
End If
cnt = 1
LDollHold = LDoll
Do While LDoll > 0
NumParts(cnt) = IIf(LDoll > 3, Right(Dollars, 3), Trim(Dollars))
Dollars = IIf(LDoll > 3, Left(Dollars, (IIf(LDoll < 3, 3, LDoll)) - 3), "")
LDoll = Len(Dollars)
cnt = cnt + 1
Loop
For cnt = TotalSets To 1 Step -1
NWord = GetWord(NumParts(cnt))
NTW = NTW & NWord
If NWord <> "" Then
If NumVal >= 2000000 And cnt = 3 Then
NTW = NTW & " Millones "
Else
NTW = NTW & Place(cnt)
End If
End If
Next cnt
If LDollHold > 0 Then
If NumVal < 2 Then
NTW = NTW & " " & WMoneda & " "
' NTW = NTW & " LEMPIRA "
Else
NTW = NTW & " " & WMoneda & " "
' NTW = NTW & " LEMPIRAS "
End If
Else
NTW = NTW & ""
End If
TotalCents = GetTens(Cents)
If TotalCents = "" Then
If NumVal < 2 Then
NTW = NTW & "EXACTO"
Else
NTW = NTW & "EXACTOS"
End If
Else
If NumVal > 1 Then
' NTW = NTW & "con " & TotalCents & " CENTAVOS"
NTW = NTW & "con " & Cents & "/100"
Else
' NTW = NTW & TotalCents & " CENTAVOS"
NTW = NTW & Cents & "/100"
End If
End If
NumToWord = NTW
Exit Function
NumToWord_Err:
NumToWord = "# ERROR #"
Resume Next
End Function
Mostrar Mensajes
