Created
March 10, 2019 11:07
-
-
Save ticapix/b62d72a5f3e9ff6e6656f3d8e7cdac23 to your computer and use it in GitHub Desktop.
VBA module to convert a number to words, in Estonian.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## Usage: in a call, enter the formula `=SpellNumber(value)`. The cell will display the number in Estonian | |
Option Explicit | |
'Main Function | |
Function SpellNumber(ByVal MyNumber) | |
Dim Dollars, Cents, Temp | |
Dim DecimalPlace, Count | |
ReDim Place(9) As String | |
Place(2) = "tuhat, " | |
Place(3) = "miljon " | |
Place(4) = "mijard " | |
Place(5) = "triljon " | |
MyNumber = Math.Round(MyNumber, 2) | |
MyNumber = Trim(Str(MyNumber)) | |
DecimalPlace = InStr(MyNumber, ".") | |
If DecimalPlace > 0 Then | |
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ | |
"00", 2)) | |
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) | |
End If | |
Count = 1 | |
Do While MyNumber <> "" | |
Temp = GetHundreds(Right(MyNumber, 3)) | |
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars | |
If Len(MyNumber) > 3 Then | |
MyNumber = Left(MyNumber, Len(MyNumber) - 3) | |
Else | |
MyNumber = "" | |
End If | |
Count = Count + 1 | |
Loop | |
Select Case Dollars | |
Case "" | |
Dollars = "null eurot" | |
Case "One" | |
Dollars = "üks euro" | |
Case Else | |
Dollars = Dollars & "eurot" | |
End Select | |
Select Case Cents | |
Case "" | |
Cents = " ja null senti" | |
Case "One" | |
Cents = " ja üks sent" | |
Case Else | |
Cents = " ja " & Cents & "senti" | |
End Select | |
SpellNumber = Dollars & Cents | |
End Function | |
Function test() | |
SpellNumber (971.05) | |
End Function | |
Function GetHundreds(ByVal MyNumber) | |
Dim Result As String | |
If Val(MyNumber) = 0 Then Exit Function | |
MyNumber = Right("000" & MyNumber, 3) | |
' Convert the hundreds place. | |
If Mid(MyNumber, 1, 1) <> "0" Then | |
Result = GetDigit(Mid(MyNumber, 1, 1)) | |
Result = Left(Result, Len(Result) - 1) & "sada " | |
End If | |
' Convert the tens and ones place. | |
If Mid(MyNumber, 2, 1) <> "0" Then | |
Result = Result & GetTens(Mid(MyNumber, 2)) | |
Else | |
Result = Result & GetDigit(Mid(MyNumber, 3)) | |
End If | |
GetHundreds = Result | |
End Function | |
Function GetTens(TensText) | |
Dim Result As String | |
Result = "" ' Null out the temporary function value. | |
If Val(TensText) = 10 Then | |
Result = "kümme" | |
Else | |
Result = GetDigit(Val(Left(TensText, 1))) | |
If Result <> "" Then | |
Result = Left(Result, Len(Result) - 1) & "kümmend " | |
End If | |
Result = Result & GetDigit(Right(TensText, 1)) | |
End If | |
GetTens = Result | |
End Function | |
Function GetDigit(Digit) | |
Select Case Val(Digit) | |
Case 1: GetDigit = "üks " | |
Case 2: GetDigit = "kaks " | |
Case 3: GetDigit = "kolm " | |
Case 4: GetDigit = "neli " | |
Case 5: GetDigit = "viis " | |
Case 6: GetDigit = "kuus " | |
Case 7: GetDigit = "seitse " | |
Case 8: GetDigit = "kaheksa " | |
Case 9: GetDigit = "üheksa " | |
Case Else: GetDigit = "" | |
End Select | |
End Function | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment