تلفظ انگلیسی اعداد در اکسل Pronunciation of Numbers in Excel

Collapse
X
 
  • زمان
  • نمایش
Clear All
new posts
  • sina20

    • 2013/11/17
    • 25

    تلفظ انگلیسی اعداد در اکسل Pronunciation of Numbers in Excel

    با استفاده از کد زیر می توان یک تابع ساخت که عدد وارد شده رو به حرف انگلیسی تبدیل کرد.
    کد PHP:
    Option Explicit



          
    '****************

          ' 
    Main Function *

          
    '****************



          Function SpellNumber(ByVal MyNumber)

              Dim Dollars, Cents, Temp

              Dim DecimalPlace, Count



              ReDim Place(9) As String

              Place(2) = " Thousand "

              Place(3) = " Million "

              Place(4) = " Billion "

              Place(5) = " Trillion "



              ' 
    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(MyNumberDecimalPlace 1) & _

                      
    "00"2))

                  
    MyNumber Trim(Left(MyNumberDecimalPlace 1))

              
    End If



              
    Count 1

              
    Do While MyNumber <> ""

                  
    Temp GetHundreds(Right(MyNumber3))

                  If 
    Temp <> "" Then Dollars Temp Place(Count) & Dollars

                  
    If Len(MyNumber) > 3 Then

                      MyNumber 
    Left(MyNumberLen(MyNumber) - 3)

                  Else

                      
    MyNumber ""

                  
    End If

                  
    Count Count 1

              Loop



              Select 
    Case Dollars

                  
    Case ""

                      
    Dollars "No Dollars"

                  
    Case "One"

                      
    Dollars "One Dollar"

                  
    Case Else

                      
    Dollars Dollars " Dollars"

              
    End Select



              Select 
    Case Cents

                  
    Case ""

                      
    Cents " and No Cents"

                  
    Case "One"

                      
    Cents " and One Cent"

                  
    Case Else

                      
    Cents " and " Cents " Cents"

              
    End Select



              SpellNumber 
    Dollars Cents

          End 
    Function







          
    '*******************************************

          ' 
    Converts a number from 100-999 into text *

          
    '*******************************************



          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(MyNumber11) <> "0" Then

                  Result 
    GetDigit(Mid(MyNumber11)) & " Hundred "

              
    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







          '
    *********************************************

          
    ' 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 
    10Result "Ten"

                      
    Case 11Result "Eleven"

                      
    Case 12Result "Twelve"

                      
    Case 13Result "Thirteen"

                      
    Case 14Result "Fourteen"

                      
    Case 15Result "Fifteen"

                      
    Case 16Result "Sixteen"

                      
    Case 17Result "Seventeen"

                      
    Case 18Result "Eighteen"

                      
    Case 19Result "Nineteen"

                      
    Case Else

                  
    End Select

              
    Else                                 ' If value between 20-99...

                  Select Case Val(Left(TensText, 1))

                      Case 2: Result = "Twenty "

                      Case 3: Result = "Thirty "

                      Case 4: Result = "Forty "

                      Case 5: Result = "Fifty "

                      Case 6: Result = "Sixty "

                      Case 7: Result = "Seventy "

                      Case 8: Result = "Eighty "

                      Case 9: Result = "Ninety "

                      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 = "One"

                  Case 2: GetDigit = "Two"

                  Case 3: GetDigit = "Three"

                  Case 4: GetDigit = "Four"

                  Case 5: GetDigit = "Five"

                  Case 6: GetDigit = "Six"

                  Case 7: GetDigit = "Seven"

                  Case 8: GetDigit = "Eight"

                  Case 9: GetDigit = "Nine"

                  Case Else: GetDigit = ""

              End Select

          End Function 

    حالا از تابع SpellNumber استفاده می کنیم و نتیجه رو میبینیم.
    Last edited by ~M*E*H*D*I~; 2014/02/18, 10:30.
  • sina20

    • 2013/11/17
    • 25

    #2
    فایل پیوست
    فایل های پیوست شده

    کامنت

    Working...