منتديات جريت بلينز العربية Great Plains For Arab

منتديات جريت بلينز العربية Great Plains For Arab (http://www.gp4arab.com/forum/index.php)
-   منتدى أكواد فيجوال بيسك VBA (http://www.gp4arab.com/forum/forumdisplay.php?f=7)
-   -   كتابة المبلغ باللغة العربية في التقارير (التفقيط) (http://www.gp4arab.com/forum/showthread.php?t=77)

Monzer Osama 07-Jul-2011 07:59 AM

كتابة المبلغ باللغة العربية في التقارير (التفقيط)
 
السلام عليكم ورحمة الله

كمطور تقارير في برنامج جريت بلينز قد تضطر أحيانا لكتابة المبلغ النهائي في بعض التقارير وخصوصا التقارير التي يستلمها العميل أو المورد (مثل الفاتورة - سند القبض - كشف الحساب -طباعة الشيك ... إلخ).
في كاتب التقاريرReport Writer لايمكنك أن تكتب التفقيط باللغة العربية بدون استخدام الـVBA وتكتب كود طويل جدا لترجمة هذه الأرقام الى كلمات ... لذلك
وضعت مايكروسوفت ملف ( Chunk File ) يمكن أن تضعه في مجلد جريت بلينز وتصمح عندك خاصية التفقيط موجودة بدون الحاجة الى استخدام الفيجوال بيسك VBA

قم بتحميل الملف المرفق من الملف التالي
http://www.gp4arab.com/files/Arabic_...p4arab.com.zip
والتعليمات موجودة بالداخل


ملاحظة:
لا تحمل الملف على نسخة جريت بلينز قبل النسخة الثامنة.


والله الموفق

MohammadSalah 07-Jul-2011 10:11 AM

جزاك الله كل خير
لإن دى كانت مشكله كبيره
لك شكرى

Monzer Osama 07-Jul-2011 10:24 AM

وإياك أخي محمد

بعد زمان ... وحشتنا يا شيخ .... :)

kh_waleed23 04-Aug-2011 09:48 AM

اكثر من رائع

عبدالله عمر علي 06-Sep-2011 05:58 AM

شكرا لكم
مع تحياتي لك العاملين على البرامج
عبدالله عمر علي

Hafandi 06-Sep-2011 03:36 PM

شكرا جزيلا لك أخي منذر

كان بودي أن أشاركك الفرحة ، ولكن ..:(

يبدو أن هذا الملف لا يفيد إلا في طباعة Payable Checks في البرنامج

للأسف إلى الآن لم تضع مايكروسوفت أمر تفقيط للعربي كما هو لللغة الانجليزية

Monzer Osama 06-Sep-2011 06:04 PM

ولا يهمك أخي حسن ... والله ما اخرب عليك الفرحة :)

تفضل هذا لكود يظهر لك العربي ....

كود:

Public Function ConvertCurrencyToArabic(MyNumber As String) As String
Dim temp
Dim Riyal, Halalah
Dim DecimalPlace, Count, CountDigit
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)
        Halalah = ConvertTens(temp)
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
CountDigit = 3
Do While MyNumber <> ""
If Left(MyNumber, 1) = "2" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" Then
                Riyals = "&Atilde; &aacute;&Yacute;&Ccedil;&auml; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
Exit Do
        End If
            If Left(MyNumber, 1) = "2" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" Then
                Riyals = "&Atilde; &aacute;&Yacute;&Ccedil;&auml; "
                Exit Do
        End If
If Left(MyNumber, 1) = "1" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" Then
                Riyals = "&Atilde;&aacute;&Yacute; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
                Exit Do
        End If
            If Left(MyNumber, 1) = "1" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" Then
                Riyals = "&Atilde;&aacute;&Yacute; "
                Exit Do
        End If
If Left(MyNumber, 1) = "3" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
                Riyals = "&Euml;&aacute;&Ccedil;&Euml;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
                Exit Do
        End If
        If Left(MyNumber, 1) = "3" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
                Riyals = "&Euml;&aacute;&Ccedil;&Euml;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
                Exit Do
        End If
        If Left(MyNumber, 1) = "4" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
                Riyals = "&Atilde;&Ntilde;&Egrave;&Uacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
                Exit Do
        End If
        If Left(MyNumber, 1) = "4" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
                Riyals = "&Atilde;&Ntilde;&Egrave;&Uacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
                Exit Do
        End If
        If Left(MyNumber, 1) = "5" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
                Riyals = "&Icirc;&atilde;&Oacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
                Exit Do
        End If
        If Left(MyNumber, 1) = "5" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
                Riyals = "&Icirc;&atilde;&Oacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
                Exit Do
        End If
        If Left(MyNumber, 1) = "6" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
                Riyals = "&Oacute;&Ecirc;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
                Exit Do
        End If
        If Left(MyNumber, 1) = "6" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
                Riyals = "&Oacute;&Ecirc;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
                Exit Do
        End If
        If Left(MyNumber, 1) = "7" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
                Riyals = "&Oacute;&Egrave;&Uacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
                Exit Do
        End If
        If Left(MyNumber, 1) = "7" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
                Riyals = "&Oacute;&Egrave;&Uacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
                Exit Do
        End If
        If Left(MyNumber, 1) = "8" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
                Riyals = "&Euml;&atilde;&Ccedil;&auml;&iacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
                temp = ConvertHundreds(Right(MyNumber, 3))
                Riyals = Riyals & temp
                Exit Do
        End If
    If Left(MyNumber, 1) = "8" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
            Riyals = "&Euml;&atilde;&Ccedil;&auml;&iacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
            Exit Do
    End If
 If Left(MyNumber, 1) = "9" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) <> "000" And CountDigit = 3 Then
            Riyals = "&Ecirc;&Oacute;&Uacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
            temp = ConvertHundreds(Right(MyNumber, 3))
            Riyals = Riyals & temp
            Exit Do
    End If
    If Left(MyNumber, 1) = "9" And Len(MyNumber) = 4 And Mid(MyNumber, 2, 3) = "000" And CountDigit = 3 Then
            Riyals = "&Ecirc;&Oacute;&Uacute;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
            Exit Do
    End If
If Left(MyNumber, 2) = "10" And Len(MyNumber) = 5 And Mid(MyNumber, 2, 4) <> "0000" And CountDigit = 3 Then
            Riyals = "&Uacute;&Ocirc;&Ntilde;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; &aelig;"
            temp = ConvertHundreds(Right(MyNumber, 3))
            Riyals = Riyals & temp
            Exit Do
    End If
    If Left(MyNumber, 1) = "1" And Len(MyNumber) = 5 And Mid(MyNumber, 2, 4) = "0000" And CountDigit = 3 Then
            Riyals = "&Uacute;&Ocirc;&Ntilde;&Eacute; &Acirc;&aacute;&Ccedil;&Yacute; "
            Exit Do
    End If
temp = ConvertHundreds(Right(MyNumber, 3))
    If temp <> "" Then
            Riyals = temp & " " & Place(Count) & " " & Riyals
    End If
    If Len(MyNumber) > 3 Then
                MyNumber = Left(MyNumber, Len(MyNumber) - 3)
    Else
            MyNumber = ""
    End If
    Count = Count + 1
    CountDigit = CountDigit + 3
 Loop
Select Case Riyals
          Case ""
                    Riyals = "&aacute;&Ccedil;&iacute;&aelig;&Igrave;&Iuml; &atilde;&Egrave;&aacute;&Ucirc;"
          Case "One"
                  Riyals = " &Ntilde;&iacute;&Ccedil;&aacute; &aelig;&Ccedil;&Iacute;&Uuml;&Iuml; "
          Case Else
                  Riyals = Riyals & " &Ntilde;&iacute;&Uuml;&Uuml;&Ccedil;&aacute; "
End Select
Select Case Halalah
          Case ""
                    Halalah = " &Yacute;&THORN;&Oslash; &aacute;&Ccedil; &Ucirc;&iacute;&Ntilde;"
          Case "&aelig;&Ccedil;&Iacute;&Iuml;"
                    Halalah = " &aelig; &aring;&aacute;&aacute;&Eacute; &aelig;&Ccedil;&Iacute;&Iuml;&Eacute; &Yacute;&THORN;&Oslash; &aacute;&Ccedil; &Ucirc;&iacute;&Ntilde;"
          Case Else
                    Halalah = " &aelig; " & Halalah & " &aring;&aacute;&aacute;&Eacute; &Yacute;&THORN;&Oslash; &aacute;&Ccedil; &Ucirc;&iacute;&Ntilde;"
 End Select
 ConvertCurrencyToArabic = Riyals & Halalah
End Function


Monzer Osama 06-Sep-2011 06:05 PM

تكملة الكود
 
كود:

Private Function ConvertHundreds(MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
If Left(MyNumber, 1) <> "0" And Left(MyNumber, 1) <> "1" And Left(MyNumber, 1) <> "2" Then
If Mid(MyNumber, 2, 1) <> "0" Then
                    Result = ConvertDigit(Left(MyNumber, 1)) & "&atilde;&Uuml;&Ccedil;&AElig;&Uuml;&Eacute; &aelig;"
            Else
                    Result = ConvertDigit(Left(MyNumber, 1)) & "&atilde;&Uuml;&Ccedil;&AElig;&Uuml;&Eacute; "
        End If
End If
If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & ConvertTens(Mid(MyNumber, 2))
    Else
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If
If Mid(MyNumber, 1, 1) = "2" And Mid(MyNumber, 2, 2) <> "00" Then
        Result = "&atilde;&Uuml;&Ccedil;&AElig;&Ecirc;&Ccedil;&auml; &aelig;" & ConvertTens(Mid(MyNumber, 2))
Else
        If Mid(MyNumber, 1, 1) = "2" And Mid(MyNumber, 2, 2) = "00" Then
                Result = "&atilde;&Uuml;&Ccedil;&AElig;&Ecirc;&Ccedil;&auml; "
        End If
End If
If Mid(MyNumber, 2, 2) <> "00" And Mid(MyNumber, 1, 1) = "1" Then
        Result = "&atilde;&Uuml;&Ccedil;&AElig;&Uuml;&Eacute; &aelig; " & ConvertTens(Mid(MyNumber, 2))
Else
        If Mid(MyNumber, 2, 2) = "00" And Mid(MyNumber, 1, 1) = "1" Then
                Result = "&atilde;&Uuml;&Ccedil;&AElig;&Uuml;&Eacute; "
        End If
End If
ConvertHundreds = Trim(Result)
End Function


Private Function ConvertTens(Mytens)
Dim Result As String
If Val(Left(Mytens, 1)) = 1 Then
Select Case Val(Mytens)
                        Case 10: Result = " &Uacute;&Ocirc;&Uuml;&Ntilde;&Eacute; "
                Case 11: Result = " &Aring;&Iacute;&Iuml;&igrave; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 12: Result = " &Aring;&Euml;&auml;&Uuml;&iacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 13: Result = " &Euml;&aacute;&Ccedil;&Euml;&Eacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 14: Result = " &Atilde;&Ntilde;&Egrave;&Uacute;&Uuml;&Eacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 15: Result = " &Icirc;&atilde;&Oacute;&Uuml;&Eacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 16: Result = " &Oacute;&Uuml;&Ecirc;&Eacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 17: Result = " &Oacute;&Uuml;&Egrave;&Uacute;&Eacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 18: Result = " &Euml;&atilde;&Ccedil;&auml;&iacute;&Uuml;&Eacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case 19: Result = " &Ecirc;&Oacute;&Uuml;&Uacute;&Eacute; &Uacute;&Ocirc;&Uuml;&Ntilde; "
                Case Else
        End Select
Else
Select Case Val(Left(Mytens, 1))
                Case 2: Result = " &Uacute;&Ocirc;&Uuml;&Ntilde;&aelig;&auml; "
                Case 3: Result = " &Euml;&Uuml;&aacute;&Ccedil;&Euml;&aelig;&auml; "
                Case 4: Result = " &Atilde;&Ntilde;&Egrave;&Uacute;&Uuml;&aelig;&auml; "
                Case 5: Result = " &Icirc;&atilde;&Oacute;&Uuml;&Uuml;&aelig;&auml; "
                Case 6: Result = " &Oacute;&Uuml;&Uuml;&Ecirc;&aelig;&auml; "
                Case 7: Result = " &Oacute;&Uuml;&Uuml;&Egrave;&Uacute;&aelig;&auml; "
                Case 8: Result = " &Euml;&Uuml;&atilde;&Uuml;&Ccedil;&auml;&aelig;&auml; "
                Case 9: Result = " &Ecirc;&Oacute;&Uuml;&Uuml;&Uacute;&aelig;&auml; "
                Case Else
        End Select
If Val(Right(Mytens, 1)) = "0" Then
            Result = ConvertDigit(Right(Mytens, 1)) & Result
Else
            Result = ConvertDigit(Right(Mytens, 1)) & " &aelig;" & Result
End If
End If
 ConvertTens = Result
End Function


Private Function ConvertDigit(MyDigit)
Select Case Val(MyDigit)
          Case 1: ConvertDigit = "&aelig;&Ccedil;&Iacute;&Uuml;&Iuml;"
          Case 2: ConvertDigit = "&Aring;&Euml;&Uuml;&auml;&Uuml;&Ccedil;&auml;"
          Case 3: ConvertDigit = "&Euml;&Uuml;&aacute;&Ccedil;&Euml;"
          Case 4: ConvertDigit = "&Atilde;&Ntilde;&Egrave;&Uuml;&Uacute;"
          Case 5: ConvertDigit = "&Icirc;&atilde;&Uuml;&Oacute;"
          Case 6: ConvertDigit = "&Oacute;&Uuml;&Ecirc;"
          Case 7: ConvertDigit = "&Oacute;&Uuml;&Egrave;&Uuml;&Uacute;"
          Case 8: ConvertDigit = "&Euml;&atilde;&Ccedil;&auml;"
          Case 9: ConvertDigit = "&Ecirc;&Uuml;&Oacute;&Uuml;&Uacute;"
End Select
End Function

Private Sub Report_BeforePF(SuppressBand As Boolean)
 arabic.Value = Trim(ConvertCurrencyToArabic(NetWagesPayRun.Value))
End Sub


فقط أضف حقل calculated Feild بالريبورت وسميه arabic وأضفه للفيجوال بيسك[/code]

Hafandi 06-Sep-2011 06:53 PM

يسلموا على الكود

أنا بالفعل لدي كود لتفقيط العربي ( طبعا ليس بهذه الاحترافية :D )

ولكن الحسرة هو عدم اهتمام مايكروسوفت بتوفير دعم هذا التفقيط مثل التفقيط الانجليزي ، مع كبر حجم سوق gp في المنطقة :cool:

yousif1 03-Nov-2011 08:14 AM

مشكووووووووووووووووووووور


جميع الأوقات بتوقيت GMT +3. الساعة الآن 01:41 PM.

Powered by vBulletin® Version 3.8.3

الموقع والمنتدى من تطوير » شركة المنذر للاستضافة والتصميم


الموقع لا يمثل أي جهة رسمية بل هو جهد شخصي يرمي الى تجميع القدرات في برنامج جريت بلينز