اذهب الي المحتوي
أوفيسنا

تحويل الوحدة النمطية من الانجليزي الى العربي

sm44ms

بواسطه sm44ms
في قسم الأكسيس Access

 مشاركة

الردود الموصى بها

sm44ms

sm44ms

قام بنشر
قام بنشر

الرجاء تحويل الوحدة النمطية كما هي من الانجليزي الى العربية  بالدرهم

وجزاكم الله خير 

Function ConvertCurrencyToArbaic(ByVal MyNumber)
  Dim Temp
         Dim AED, Cents
         Dim DecimalPlace, Count
         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "
         MyNumber = Trim(Str(MyNumber))
         DecimalPlace = InStr(MyNumber, ".")
        If DecimalPlace > 0 Then
         Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If
         Count = 1
         Do While MyNumber <> ""
            Temp = ConvertHundreds(Right(MyNumber, 3))
            If Temp <> "" Then AED = Temp & Place(Count) & AED
            If Len(MyNumber) > 3 Then
               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
            Else
               MyNumber = ""
            End If
            Count = Count + 1
         Loop
         Select Case AED ''يمكنك وضع أي عملة تريدها بدلا من الدولار طبعا بالنجليزي
            Case ""
               AED = "No AED"
            Case "One"
               AED = "One AED"
            Case Else
               AED = AED & " AED"
         End Select
         Select Case Cents
         Case ""
         Cents = ""
           Case "One"
               Cents = " And One Cent"
            Case Else
               Cents = " And " & Cents & " Cents"
         End Select
         ConvertCurrencyToArbaic = AED & Cents
End Function
Private Function ConvertDigit(ByVal MyDigit)
        Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
End Function
Private Function ConvertHundreds(ByVal MyNumber)
    Dim Result As String
         If Val(MyNumber) = 0 Then Exit Function
         MyNumber = Right("000" & MyNumber, 3)
         If Left(MyNumber, 1) <> "0" Then
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
         End If
         If Mid(MyNumber, 2, 1) <> "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If
         ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens(ByVal MyTens)
          Dim Result As String
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               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
          
            Select Case Val(Left(MyTens, 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 & ConvertDigit(Right(MyTens, 1))
         End If
         ConvertTens = Result
End Function

 

رابط هذا التعليق
شارك
Foksh

Foksh

قام بنشر
قام بنشر (معدل)

تفضل أخي الكريم ،، 

Function ConvertCurrencyToArabic(ByVal MyNumber)
    Dim Temp
    Dim AED, Cents
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " ألف "
    Place(3) = " مليون "
    Place(4) = " مليار "
    Place(5) = " تريليون "
    
    MyNumber = Trim(Str(MyNumber))
    DecimalPlace = InStr(MyNumber, ".")
    
    If DecimalPlace > 0 Then
        Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
        Cents = ConvertTens(Temp)
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    
    Count = 1
    
    Do While MyNumber <> ""
        Temp = ConvertHundreds(Right(MyNumber, 3))
        
        If Temp <> "" Then
            AED = Temp & Place(Count) & AED
        End If
        
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        
        Count = Count + 1
    Loop
    
    Select Case AED
        Case ""
            AED = "لا يوجد درهم"
        Case "One"
            AED = "درهم واحد"
        Case Else
            AED = AED & " درهم"
    End Select
    
    Select Case Cents
        Case ""
            Cents = ""
        Case "One"
            Cents = " "
        Case Else
            Cents = " و" & Cents & " "
    End Select
    
    ConvertCurrencyToArabic = AED & Cents
End Function

Private Function ConvertDigit(ByVal MyDigit)
    Select Case Val(MyDigit)
        Case 1: ConvertDigit = "واحد"
        Case 2: ConvertDigit = "اثنان"
        Case 3: ConvertDigit = "ثلاثة"
        Case 4: ConvertDigit = "أربعة"
        Case 5: ConvertDigit = "خمسة"
        Case 6: ConvertDigit = "ستة"
        Case 7: ConvertDigit = "سبعة"
        Case 8: ConvertDigit = "ثمانية"
        Case 9: ConvertDigit = "تسعة"
        Case Else: ConvertDigit = ""
    End Select
End Function

Private Function ConvertHundreds(ByVal MyNumber)
    Dim Result As String
    
    If Val(MyNumber) = 0 Then Exit Function
    
    MyNumber = Right("000" & MyNumber, 3)
    
    If Left(MyNumber, 1) <> "0" Then
        Result = ConvertDigit(Left(MyNumber, 1)) & " مئة "
    End If
    
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & ConvertTens(Mid(MyNumber, 2))
    Else
        Result = Result & ConvertDigit(Mid(MyNumber, 3))
    End If
    
    ConvertHundreds = Trim(Result)
End Function

Private Function ConvertTens(ByVal MyTens)
    Dim Result As String
    
    If Val(Left(MyTens, 1)) = 1 Then
        Select Case Val(MyTens)
            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
        Select Case Val(Left(MyTens, 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 & ConvertDigit(Right(MyTens, 1))
    End If
    
    ConvertTens = Result
End Function

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

 

تفقيط الارقام فى الاكسس.accdb

تم تعديل بواسطه Foksh
  • Thanks 1
رابط هذا التعليق
شارك
sm44ms

sm44ms

قام بنشر
  • الكاتب
قام بنشر

فيه خطا ء بسيط لو تشوفه جزاك الله خير

image_2023-12-12_110957983.png

يوجد خطاء في ترتيب القيمة بالاضافة الى ذلك لايوجد قيمة الفلس

وشكرا

رابط هذا التعليق
شارك
Moosak

Moosak

قام بنشر
قام بنشر
في 15‏/12‏/2023 at 09:02, sm44ms said:

الاخ خليفه سوال

من اين اختار افضل اجابة  او كيف طريقة استخداهما 

ستجد عبارة اختر كأفضل إجابة اسفل كل مشاركة ..

         image.png.d2aa5dd4edbc709684054107a37a9530.png

الهدف منها ارشاد رواد المنتدى بالإجابة الأفضل التي تجيب على سؤالك ..

🙂

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept