المساعد الشخصي الرقمي

مشاهدة النسخة كاملة : كتابة المبلغ باللغة العربية في التقارير (التفقيط)

Monzer Osama
07-Jul-2011, 07:59 AM
السلام عليكم ورحمة الله

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

قم بتحميل الملف المرفق من الملف التالي
http://www.gp4arab.com/files/Arabic_char_Gp4arab.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
مشكووووووووووووووووووووور
kh_waleed23
05-Nov-2011, 06:40 PM
ملف موديل
اضف هذا الموديل في الفيجوال بيسك
----------------------------
واذا اردت أن تفقط أي حقل أو Filed
<حقل التفقيط> = Replace(WriteNo(CStr(جقل المراد تفقيطه>), 0), " ريال ", "")


,g;l hgjpdm
زاهرعبدالرحمن
25-Feb-2012, 05:06 PM
ياشباب رجاء تفقيط الداتا ريبورت عندما يكون لدي مجموع بآخر التقرير
وكيف تمرير التفقيط بلغة الفيجوال بيسك 6
Monzer Osama
26-Feb-2012, 07:02 AM
ياشباب رجاء تفقيط الداتا ريبورت عندما يكون لدي مجموع بآخر التقرير
وكيف تمرير التفقيط بلغة الفيجوال بيسك 6

ألم ينفع معك رد الأخkh_waleed23 ؟
زاهرعبدالرحمن
27-Feb-2012, 07:29 AM
أناكلامي تفقيط مجموع عمود ما يظهر في نهاية التقريركمجموع عمود الرواتب لموظفين
Monzer Osama
27-Feb-2012, 08:04 AM
وهذا هو المقصود أيضا...http://www.gp4arab.com/forum/showpost.php?p=3363&postcount=11

كل ما عليك هو إضافة الحقل الذي فيه رقم (مثلا حقل مجموع الرواتب للموظفين ) الى الفيجوال بيسك من خلال الريبورت رايتر وبعدها تمرره الى الـ Function ليستبدل لك الأحرف بدل الأرقام وانت وقتها يجب عليك أن تضيف Calucalted Field في الـReport writer وتضع فيه قيمة الأحرف .... بلغنا لو واجهت صعوبة ..
زاهرعبدالرحمن
27-Feb-2012, 08:43 AM
لاأدري إن كان سؤالي واضح أو أنه الغموض يخيم عليه
؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟
زاهرعبدالرحمن
27-Feb-2012, 09:54 AM
الله يجزاكم كل خير بس أقصدأنهأظهر ريبورت كامل و الإجمالي أسفل الصفحة
كأرقاممن خلال function المجموع الموجود بصفحة تصميم الداتا ريبورت
و لكن تحويل الرقم لكاتبة ؟؟؟؟
هل يمكن مثال بسيط من أجل هذه المشلكة
ahmedzico
02-Mar-2012, 08:19 AM
عذرا اخي زاهر
ماذا تقصد بالــ الداتا ريبورت ؟؟
هل تعمل تقرير في فجوال بيسيك 6 بهذا الكنترول ام ماذا ؟
فالمشاركات الحالية تتكلم عن التفقيط فيما يسمى بالريبورت رايتر وهي موجودة مع الجريت بلينز .
ارجو التوضيح مع الشكر
زاهرعبدالرحمن
14-Mar-2012, 02:30 PM
مرحبا شباب قصدي الداتا ريبورت اللي مع الفيجوال بيسك 6
انا وضعت Sum(amount) هو ال function الذي يحسب مجموع الحقل amount
لكن أريد وضع الرقم كتابة في نهاية التقرير
خير الله
24-May-2012, 05:28 PM
ِشكرا على الجهد الرائع
alouma
07-Aug-2012, 08:27 AM
meciiiiiiiiiiiiii
hishamglal65
07-Jan-2013, 06:42 AM
شكرا لك استاذنا الجليل على توفيركم هذا الكود الجميل الهام لكل من يعمل فى هذا المجال
:)
ahmed gendy gp
08-Nov-2013, 12:08 PM
مشكور مقع لمساعدة العاملين في مجال erp
ahmed gendy gp
08-Nov-2013, 12:36 PM
عند إضافة الملف الخاص بالتفقيط العربي يحدث الاتي :
1-لا يفتح الجريت بلينز بالعربي
2- وعند إضافته لمجلد الجريت بلينز لا يظهر بالفاتورة
أرجو الرد بسرعة من فضلكم ولكم جزيل الشكر والاحترام
as_radwan
08-Nov-2013, 11:01 PM
عند إضافة الملف الخاص بالتفقيط العربي يحدث الاتي :
1-لا يفتح الجريت بلينز بالعربي
2- وعند إضافته لمجلد الجريت بلينز لا يظهر بالفاتورة
أرجو الرد بسرعة من فضلكم ولكم جزيل الشكر والاحترام

الرد علي الفقرة الثانية هي:
1- وضع صلاحية للمستخدمين علي التقارير المعدلة
2-لابد من التأكد من التعامل بشكل صحيح مع الحقل الجديد المضاف
3-حاول ان تجرب علي نسخة غير معربة في البداية لضمان سلامة عملية التفقيط

اذا تمت بنجاح فقم بالاتصال علي الشركة صاحبة النسخة العربية لتقوم بحل المشكلة الاولي.