Function SumInWordsUAH(ByVal MyNumber As Double) As String
Dim UAH As String, KOP As String
Dim TempStr As String, DecimalPlace As Integer
Dim Count As Integer
Dim Receptacles As Variant
Dim Place(9) As String
Place(2) = " тисяч"
Place(3) = " мільйон"
Place(4) = " мільярд"
MyNumber = Round(MyNumber, 2)
TempStr = Trim(Str(MyNumber))
DecimalPlace = InStr(TempStr, ".")
If DecimalPlace > 0 Then
KOP = Left(Mid(TempStr, DecimalPlace + 1) & "00", 2)
TempStr = Trim(Left(TempStr, DecimalPlace - 1))
Else
KOP = "00"
End If
Count = 1
Do While TempStr <> ""
Dim TempVal As Integer
Dim TempWord As String
TempVal = Val(Right(TempStr, 3))
If TempVal > 0 Then
TempWord = GetHundreds(TempVal, Count)
' Узгодження закінчень для тисяч, мільйонів, мільярдів
If Count = 2 Then ' Тисячі
If TempVal Mod 100 >= 11 And TempVal Mod 100 <= 19 Then
TempWord = TempWord & Place(Count) & " "
Else
Select Case TempVal Mod 10
Case 1: TempWord = TempWord & Place(Count) & "а "
Case 2 To 4: TempWord = TempWord & Place(Count) & "і "
Case Else: TempWord = TempWord & Place(Count) & " "
End Select
End If
ElseIf Count = 3 Or Count = 4 Then ' Мільйони та Мільярди
If TempVal Mod 100 >= 11 And TempVal Mod 100 <= 19 Then
TempWord = TempWord & Place(Count) & "ів "
Else
Select Case TempVal Mod 10
Case 1: TempWord = TempWord & Place(Count) & " "
Case 2 To 4: TempWord = TempWord & Place(Count) & "и "
Case Else: TempWord = TempWord & Place(Count) & "ів "
End Select
End If
Else
TempWord = TempWord & " "
End If
UAH = TempWord & UAH
End If
If Len(TempStr) > 3 Then
TempStr = Left(TempStr, Len(TempStr) - 3)
Else
TempStr = ""
End If
Count = Count + 1
Loop
If UAH = "" Then UAH = "Нуль "
' Узгодження валюти (Гривня)
Dim LastTwo As Integer
LastTwo = Val(Right(Trim(Str(Fix(MyNumber))), 2))
If LastTwo >= 11 And LastTwo <= 19 Then
UAH = UAH & "гривень "
Else
Select Case LastTwo Mod 10
Case 1: UAH = UAH & "гривня "
Case 2 To 4: UAH = UAH & "гривні "
Case Else: UAH = UAH & "гривень "
End Select
End If
' Форматування результату
UAH = Trim(UAH)
UAH = UCase(Left(UAH, 1)) & Mid(UAH, 2)
SumInWordsUAH = UAH & " " & KOP & " копійок"
End Function
Private Function GetHundreds(ByVal MyNumber As Integer, ByVal Period As Integer) As String
Dim Result As String
If MyNumber = 0 Then Exit Function
' Сотні
Select Case MyNumber \ 100
Case 1: Result = "сто "
Case 2: Result = "двісті "
Case 3: Result = "триста "
Case 4: Result = "чотириста "
Case 5: Result = "п'ятсот "
Case 6: Result = "шістсот "
Case 7: Result = "сімсот "
Case 8: Result = "вісімсот "
Case 9: Result = "дев'ятсот "
End Select
MyNumber = MyNumber Mod 100
' Десятки та Одиниці
If MyNumber >= 11 And MyNumber <= 19 Then
Select Case MyNumber
Case 11: Result = Result & "одинадцять"
Case 12: Result = Result & "дванадцять"
Case 13: Result = Result & "тринадцять"
Case 14: Result = Result & "чотирнадцять"
Case 15: Result = Result & "п'ятнадцять"
Case 16: Result = Result & "шістнадцять"
Case 17: Result = Result & "сімнадцять"
Case 18: Result = Result & "вісімнадцять"
Case 19: Result = Result & "дев'ятнадцять"
End Select
Else
Select Case MyNumber \ 10
Case 1: Result = Result & "десять "
Case 2: Result = Result & "двадцять "
Case 3: Result = Result & "тридцять "
Case 4: Result = Result & "сорок "
Case 5: Result = Result & "п'ятдесят "
Case 6: Result = Result & "шістдесят "
Case 7: Result = Result & "сімдесят "
Case 8: Result = Result & "вісімдесят "
Case 9: Result = Result & "дев'яносто "
End Select
MyNumber = MyNumber Mod 10
Select Case MyNumber
Case 1:
If Period = 2 Or Period = 1 Then ' Жіночий рід для тисяч і гривень
Result = Result & "одна"
Else
Result = Result & "один"
End If
Case 2:
If Period = 2 Or Period = 1 Then
Result = Result & "дві"
Else
Result = Result & "два"
End If
Case 3: Result = Result & "три"
Case 4: Result = Result & "чотири"
Case 5: Result = Result & "п'ять"
Case 6: Result = Result & "шість"
Case 7: Result = Result & "сім"
Case 8: Result = Result & "вісім"
Case 9: Result = Result & "дев'ять"
End Select
End If
GetHundreds = Trim(Result)
End Function