پرفروش ترين
برترين
آخرين محصولات فروشگاه
فایل الکترونیکی آموزش اکسل پیشرفته ۲۰۱۰
آموزش ایجاد فایل چندکاربره با سطح دسترسی مشخص
نمایش نتایج: از شماره 1 تا 2 , از مجموع 2

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

  1. #1


    آخرین بازدید
    2019/05/31
    تاریخ عضویت
    November 2013
    نوشته ها
    25
    امتیاز
    161
    سپاس
    4
    سپاس شده
    151 در 22 پست
    تعیین سطح نشده است

    تلفظ انگلیسی اعداد در اکسل 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 استفاده می کنیم و نتیجه رو میبینیم.
    اخطار: این یک موضوع قدیمی است
    به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.
    ویرایش توسط ~M*E*H*D*I~ : 2014/02/18 در ساعت 11:30


  2.  

  3. #2


    آخرین بازدید
    2019/05/31
    تاریخ عضویت
    November 2013
    نوشته ها
    25
    امتیاز
    161
    سپاس
    4
    سپاس شده
    151 در 22 پست
    تعیین سطح نشده است

    فایل پیوست
    فايل هاي پيوست شده فايل هاي پيوست شده



اطلاعات موضوع

کاربرانی که در حال مشاهده این موضوع هستند

در حال حاضر 1 کاربر در حال مشاهده این موضوع است. (0 کاربران و 1 مهمان ها)

موضوعات مشابه

  1. کتاب و مقالات فاسی و انگلیسی
    توسط MEYTI در انجمن معرفی کتاب و منابع آموزشی
    پاسخ ها: 11
    آخرين نوشته: 2016/12/05, 18:54
  2. دیکشنری انگلیسی به فارسی با تلفظ IPA
    توسط omidboxter در انجمن add-ins
    پاسخ ها: 0
    آخرين نوشته: 2012/10/12, 02:34
  3. تبدیل کاراکترهای فارسی و انگلیسی به هم
    توسط Javid Mokhtari در انجمن سوالات پیرامون ويژوال بيسيك - VBA Questions
    پاسخ ها: 3
    آخرين نوشته: 2012/04/01, 02:35
  4. پاسخ ها: 0
    آخرين نوشته: 2011/08/06, 12:40
  5. فرمول نویسی ماتریسی
    توسط mrexcel در انجمن آموزش توابع اكسل
    پاسخ ها: 0
    آخرين نوشته: 2011/03/11, 09:17

بازدید کنندگان با جستجو های زیر این صفحه را پیدا کرده اند

انجمن اكسل ايران , اكسل , اكسس , سوال و جواب اكسل , سوال اكسس , انجمن اكسل ايران , توابع اكسل, آموزش اكسل, آموزش اكسس, VBA, ويژوال بيسيك

کلمات کلیدی این موضوع

علاقه مندی ها (Bookmarks)

مجوز های ارسال و ویرایش

  • شما نمیتوانید موضوع جدیدی ارسال کنید
  • شما امکان ارسال پاسخ را ندارید
  • شما نمیتوانید فایل پیوست کنید.
  • شما نمیتوانید پست های خود را ویرایش کنید
  •  
  • BB code ها فعال هستند
  • شکلک ها فعال هستند
  • کد [IMG] فعال است
  • کد [VIDEO] فعال است
  • کد HTML غیر فعال است
با ما در تماس باشيد