التفقيط بالانجليزية للريال

[yalla]

السلام عليكم ورحمة اله وبركاته

راجعت مواضيع الاساتذة حسام نور ومحمد طاهر بخصوص التفقيط

جهود رائعه مشكورين عليها وكل الاخوان بالمنتدى

اريد تفقيط بالانجليزية بعملة ريال سعودي واخرى بالدولار

شاكرين لكم جهودكم المميزة

[يحيى حسين]

السلام عليكم و رحمة الله و بركاته

أخي هذا كود تفقيط بالدولار و هو من موقع مايكروسوفت

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(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 = "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(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " 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 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "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</P> <P>

و هو موجود على هذا الرابط http://support.microsoft.com/kb/213360/en-us و بعد ان تضيفه داخل موديول في الاكسيل اكتب داخل اي خلية ترغم في التفقيط داخلها الدالة التالية و على ان يكون الرقم داخل الخلية A1

=SpellNumber(A1)

هذا بخصوص الدولار الامريكي

اما بخصوص الريال السعودي

هل تريد كتابة الريال السعودية

كيف تريد كتابة كلمة ريال RS

ام كلمة كاملة و ما هو لفظ العملة الفرعية في الريال السعودي بدل من السنت الامريكي

و دمت في حفظ الله

[نزار سليمان عيد]

السلام عليكم

جزاك الله خيرا اخي justice

اخي yalla

مرفق ملف من عمل احد الاخوة بالمنتدى وقمت بتعديل بسيط على العملة ليتناسب الدولار والريال

مع الشكر

ابو خالد

Nizar_Arabic___English.rar

تم تعديل فبراير 24, 2009 بواسطه نزار سليمان عيد

[yalla]

الف شكر لكم اخوتي الاعزاء

يعطيكم مليون عافية

بس ما ضبطت معي انا اخذت الصيغ من موضوع ثاني بالعربي وضبطت

تم تعديل مارس 1, 2009 بواسطه yalla

[amoudi]

السلام عليكم

للأستفادة

يوجد عندي ملف قددددددددددددددددددددددددددديم

تفقيط بدون ماكرو

تحياتي

Only.rar

[يحيى حسين]

السلام عليكم و رحمة الله و بركاته

هذا ايضاً ملف اخر للتفقيط بدون كود

NumsToWords_No_VBA.zip

[عاشق ترابها]

ياليت يا أخوان تفقيط بالعربي بدون إضافة أي عملة فقط تفقيط عربي والأرقام بالطبع عربية وشكراً

[نزار سليمان عيد]

السلام عليكم

اليك هذا المرفق من عمل اخي الحبيب خبور جزاه الله خيرا

مع الشكر

ابو خالد

__________________.rar

[عاشق ترابها]

السلام عليكم

اليك هذا المرفق من عمل اخي الحبيب خبور جزاه الله خيرا

مع الشكر

ابو خالد

بارك الله فيك وبارك الله في الأخ خبور والله يجزاكم خير

بس وشلون أستخدمها ما عرفت الطريقة وشاكر لك

[نزار سليمان عيد]

[quote name=

بارك الله فيك وبارك الله في الأخ خبور والله يجزاكم خير

بس وشلون أستخدمها ما عرفت الطريقة وشاكر لك

[عاشق ترابها]

مشكور أخي نزار المشكلة أنني لما غير المبلغ بالأرقام في العمود A لم يتغير التفقيط نهائياً هنا المشكلة وشاكر لك

[نزار سليمان عيد]

اخي الكريم

السلام عليكم

ماهو مستوى الامان لديك؟

يجب ان يكون منخفض وهذا احتمال لان البرنامج عندي شغال

مع الشكر

نزار

[عاشق ترابها]

اخي الكريم

السلام عليكم

ماهو مستوى الامان لديك؟

يجب ان يكون منخفض وهذا احتمال لان البرنامج عندي شغال

مع الشكر

نزار

أبو خالد مستوى الأمان منخفض عندي وعندي أوفيس 2003

[amoudi]

السلام عليكم

اخي الكريم

الحساب في الملف موضوع على يدوي خليه تلقائي

أدوات

خيارات

(حساب)

اشر على تلقائي

تحياتي