Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
vag
 
Posts: n/a
Default I NEED HELP with the SPELLNUMBER Function


Help!

I try to convert numbers to greek currency

The problem is that in greek numbers, hundreds follow the rule of tens,
but without distiction. I've tried to solve this but couldn't work it
out. Also one thousand does not follow the rule of two thousand, three
thousand etc.
so the problem is to modify correctly the GetHundreds and the
SpellNumber function
If anyone can help me please reply
Thanks
vag

PS below is the code from microsoft,modified by me. works until 100
then...

****Doesn't work****
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim ευρώ, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " χιλιάδες "
Place(3) = "
εκατομύρια "
Place(4) = "
δισεκατομύρια
"
Place(5) = "
τρισεκατομύρια
"
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
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
If Temp < "" Then ευρώ = Temp & Place(Count) &
ευρώ
If Len(MyNumber) 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case ευρώ
Case ""
ευρώ = ""
Case "One"
ευρώ = "ένα
ευρώ"
Case Else
ευρώ = ευρώ & "
ευρώ"
End Select
Select Case Cents
Case ""
Cents = ""
Case "One"
Cents = " and ένα λεπτό"
Case Else
Cents = " and " & Cents & " λεπτά"
End Select
SpellNumber = ευρώ & Cents
End Function

' Converts a number from 100-999 into text
Function GetHundreds(HundredsText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(HundredsText, 2)) Then
Select Case Val(HundredsText)
Case 100: Result = "εκατό"
Case 200: Result = "διακόσια"
Case 300: Result =
"τριακόσια"
Case 400: Result =
"τετρακόσια"
Case 500: Result =
"πεντακόσια"
Case 600: Result = "εξακόσια"
Case 700: Result =
"επτακόσια"
Case 800: Result =
"οκτακόσια"
Case 900: Result =
"εννιακόσια"
Case Else
End Select
Result = Result & GetTens & GetDigit _
End If
GetHundreds = Result
End Function[/color]
****Doesn't work****


' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "δέκα"
Case 11: Result = "έντεκα"
Case 12: Result = "δώδεκα"
Case 13: Result = "δεκατρία"
Case 14: Result =
"δεκατέσσερα"
Case 15: Result =
"δεκαπέντε"
Case 16: Result = "δεκαέξι"
Case 17: Result = "δεκαεπτά"
Case 18: Result = "δεκαοκτώ"
Case 19: Result =
"δεκαεννέα"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "είκοσι "
Case 3: Result = "τριάντα "
Case 4: Result = "σαράντα "
Case 5: Result = "πενήντα "
Case 6: Result = "εξήντα "
Case 7: Result =
"εβδομήντα "
Case 8: Result = "ογδόντα "
Case 9: Result = "ενενήντα "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function

' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "ένα"
Case 2: GetDigit = "δύο"
Case 3: GetDigit = "τρία"
Case 4: GetDigit = "τέσσερα"
Case 5: GetDigit = "πέντε"
Case 6: GetDigit = "έξι"
Case 7: GetDigit = "επτά"
Case 8: GetDigit = "οκτώ"
Case 9: GetDigit = "εννιά"
Case Else: GetDigit = ""
End Select
End Function


--
vag
------------------------------------------------------------------------
vag's Profile: http://www.excelforum.com/member.php...o&userid=24328
View this thread: http://www.excelforum.com/showthread...hreadid=380784

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel option to store trendline's coefficients in cells for use Miguel Saldana Charts and Charting in Excel 9 June 20th 05 08:45 PM
Date & Time mully New Users to Excel 4 May 23rd 05 11:56 AM
Automatically up date time in a cell Mark Excel Discussion (Misc queries) 5 May 12th 05 12:26 AM
clock Wildman Excel Worksheet Functions 2 April 26th 05 10:31 AM
Spellnumber Norman Jones Excel Worksheet Functions 6 December 13th 04 07:21 AM


All times are GMT +1. The time now is 07:49 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"