التفقيط بالعربية

[بوكفوس عبدالسلام]

السلام عليكم جميعاً...

هناك تفقيطان أحدهما بالفرنسية ( نسخة مرفقة ) و الأخر بالعربية ( نسخة مرققة ) ، بالنسبة للتفقيط بالفرنسية فلا إشكال فيه فهو يعمل بطريقة صحيحة ، مشكلتي في التفقيط بالعربية حيث أنه لا تظهر بعد الفاصلة قي المبلغ ترجمة قيمة السنتيم ( عملتنا الدينار و بعد الفاصلة السنتيم ) مثلاً :

المبلغ  240000,00 دج تفقط بـ ( مئتان و أربعون ألف دينار جزائري و صفر سنتيم ) أو ( مئتان و أربعون ألف دينار جزائري و 00 سنتيم ).

أما في قاعدة بياناتي تفقط  ( مئتان و أربعون ألف دينار جزائري )

التفقيط بالعربية.docx التفقيط بالفرنسية.docx

[husamwahab]

جرب ان تبدل السطر الاخير

NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur

بهذا السطر

NoToTxt2 = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + " وصفر " + MySubCur

 

[بوكفوس عبدالسلام]

السلام عليكم ...

إختفى تماما

[husamwahab]

هل ممكن ان ترسل قاعدة البيانات

ملاحظة : الانتباه الى اسم الدالة لانه قد يكون مختلف عندك

[محمد أبوعبدالله]

بالاضافة الى ما تفضل به استانا الفاضل @husamwahab وله جزيل الشكر

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

Public Function write_Number(numberp)
    On Error Resume Next
    Dim ttpa, xp, a, number_s, fl As String
    Dim zp, z As Integer
    Dim c1, c2, c3 As String
    number_s = Str(Format(numberp, "0.00"))
    If Left(Right(number_s, 2), 1) = "." Then number_s = number_s & "0"
    If Left(Right(number_s, 3), 1) <> "." Then number_s = number_s & ".00"
    number_s = Trim(number_s)
    zp = Len(number_s)
    z = 1
    Do While zp > 0
      c1 = ""
      c2 = ""
      c3 = ""
      If zp = 12 Or zp = 9 Or zp = 6 Then
        a = Mid(number_s, z, 1)
        zp = zp - 1
          Select Case a
              Case "0"
               c3 = ""
              Case "1"
                c3 = "ومائة "
              Case "2"
                c3 = "ومائتان "
              Case "3"
               c3 = "وثلاثمائة "
              Case "4"
               c3 = "واربعمائة "
              Case "5"
               c3 = "وخمسمائة "
              Case "6"
               c3 = "وستمائة "
              Case "7"
               c3 = "وسبعمائة "
              Case "8"
               c3 = "وثمانمائة "
              Case "9"
               c3 = "وتسعمائة "
          End Select
          z = z + 1
      End If
      If zp = 3 Then
         z = z + 1
         zp = zp - 1
      End If
      a = Mid(number_s, z, 1)
      If zp = 2 Or zp = 5 Or zp = 8 Or zp = 11 Then
          Select Case a
              Case "0"
               c2 = ""
              Case "1"
                   c2 = "عشر "
              Case "2"
                   c2 = "وعشرون "
              Case "3"
                   c2 = "وثلاثون "
              Case "4"
                   c2 = "واربعون "
              Case "5"
                   c2 = "وخمسون "
              Case "6"
                   c2 = "وستون "
              Case "7"
                   c2 = "وسبعون "
              Case "8"
                   c2 = "وثمانون "
              Case "9"
                   c2 = "وتسعون "
           End Select
           zp = zp - 1
           z = z + 1
       End If
       a = Mid(number_s, z, 1)
       If zp = 1 Then   ' الهللات
           Select Case a
              Case "0"
               c1 = ""
              Case "1"
               If c2 = "عشر " Then
                  c1 = "واحدى "
               Else
                  c1 = "وواحد "
               End If
              Case "2"
               If c2 = "عشر " Then
                  c1 = "واثنتا "
               Else
                  c1 = "واثناتان "
               End If
              Case "3"
               c1 = "وثلاث "
              Case "4"
               c1 = "واربع "
              Case "5"
               c1 = "وخمس "
              Case "6"
               c1 = "وست "
             Case "7"
               c1 = "وسبع "
              Case "8"
                c1 = "وثمان "
              Case "9"
                 c1 = "وتسع "
            End Select
       Else  ' الريالات
           Select Case a
              Case "0"
               c1 = ""
               If c2 = "عشر " Then
                   c2 = "وعشرة "
               End If
              Case "1"
               If c2 = "عشر " Then
                  c1 = "واحدى "
               Else
                  c1 = "وواحد "
               End If
              Case "2"
               If c2 = "عشر " Then
                  c1 = "واثنا "
               Else
                  c1 = "واثنان "
               End If
              Case "3"
               c1 = "وثلاثة "
              Case "4"
               c1 = "واربعة "
              Case "5"
               c1 = "وخمسة "
              Case "6"
               c1 = "وستة "
             Case "7"
               c1 = "وسبعة "
              Case "8"
                c1 = "وثمانية "
              Case "9"
                 c1 = "وتسعة "
           End Select
       End If
      zp = zp - 1
      z = z + 1
      Select Case zp
          Case 9
            Select Case c1 + c2 + c3
               Case "وواحد "
                    xp = xp + "ومليون "
               Case "واثنان "
                    xp = xp + "ومليونان"
               Case Else
                       xp = xp + c3 + c1 + c2 + "مليون "
             End Select
          Case 6
             Select Case c1 + c2 + c3
               Case "وواحد "
                    xp = xp + "والف "
               Case "واثنان "
                    xp = xp + "والفان "
               Case "وثلاثة "
                    xp = xp + "وثلاثة الاف "
               Case "واربعة "
                    xp = xp + "واربعة الاف "
               Case "وخمسة "
                    xp = xp + "وخمسة الاف "
               Case "وستة "
                    xp = xp + "وستة الاف "
               Case "وسبعة "
                    xp = xp + "وسبعة الاف "
               Case "وثمانية "
                    xp = xp + "وثمانية الاف "
               Case "وتسعة "
                    xp = xp + "وتسعة الاف "
               Case Else
                    If c2 = "وعشرة " Then
                        xp = xp + c3 + c1 + c2 + "الاف "
                    Else
                       xp = xp + c3 + c1 + c2 + "الف "
                    End If
             End Select
          Case 3
             If c2 = "" Then
                 Select Case c1
                   Case "وواحد "
                        c1 = "ديناراً "
                   Case "واثنان "
                        c1 = "ديناراًن "
                   Case "وثلاثة "
                        c1 = "وثلاثة دينارات "
                   Case "واربعة "
                        c1 = "واربعة دينارات "
                   Case "وخمسة "
                        c1 = "وخمسة دينارات "
                   Case "وستة "
                        c1 = "وستة دينارات "
                   Case "وسبعة "
                        c1 = "وسبعة دينارات "
                   Case "وثمانية "
                        c1 = "وثمانية دينارات "
                   Case "وتسعة "
                        c1 = "وتسعة دينارات "
                    Case Else
                        c1 = "ديناراً "
                 End Select
                 xp = xp + c3 + c1 + c2
             Else
                 xp = xp + c3 + c1 + c2 + "ديناراً "
             End If
          Case 0
               If c1 + c2 <> "" Then
                   If c2 = "" Then
                       Select Case c1
                         Case "وواحد "
                              xp = xp + "وسنتيماً واحداً"
                         Case "واثنان "
                              xp = xp + "وسنتيمان "
                         Case Else
                              xp = xp + c1 + "سنتيم "
                       End Select
                   Else
                       xp = xp + c1 + c2 + "سنتيم "
                   End If
                 Else
                    xp = xp + c1 + c2 + "وصفر سنتيم "
               End If
          End Select
    Loop
    xp = LTrim(xp)
    zp = Len(xp) - 1
    If Left(xp, 1) = "و" Then
       xp = Mid(xp, 2, zp)
    End If
    ttpa = xp
    write_Number = ttpa
End Function

طريقة الاستخدام في الاستعلام او النموذج او التقرير كالتالي

write_Number([textbox])

تحياتي

[husamwahab]

تسلم ايديك استاذ محمد أبوعبدالله

طلب اذا امكن استاذنا العزيز وضع الدالة داخل قاعدة بيانات

لان النسخ عندي يسبب مشاكل مع الاحرف العربية

[محمد أبوعبدالله]

اتفضل استاذنا الغالي

D33.rar

تحياتي

[husamwahab]

جميل جدا استاذ محمد أبوعبدالله

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

[محمد أبوعبدالله]

الان, husamwahab said:

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

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

تسلم يا غالي

تحياتي