مدونة منذر اسامة

العودة   منتديات جريت بلينز العربية Great Plains For Arab > منتدى مطوري جريت بلينز > منتدى أكواد فيجوال بيسك VBA

إضافة رد
 
أدوات الموضوع انواع عرض الموضوع
قديم 07-Jul-2011, 07:59 AM   #1
Monzer Osama
مدير عام منتديات جريت بلينز العربية
Lightbulb كتابة المبلغ باللغة العربية في التقارير (التفقيط)

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

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

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


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


والله الموفق
__________________
Monzer Osama
Saudia Arabia - Jeddah
00966501826235
Microsoft Certified Business Management Solutions Professional
Microsoft Certified Trainer
Monzer Osama غير متواجد حالياً   رد مع اقتباس
قديم 07-Jul-2011, 10:11 AM   #2
MohammadSalah
عضو نشيط
 
الصورة الرمزية MohammadSalah
 
تاريخ التسجيل: Jun 2007
الدولة: مصر
المشاركات: 56
من مواضيعي  
افتراضي

جزاك الله كل خير
لإن دى كانت مشكله كبيره
لك شكرى
MohammadSalah غير متواجد حالياً   رد مع اقتباس
قديم 07-Jul-2011, 10:24 AM   #3
Monzer Osama
مدير عام منتديات جريت بلينز العربية
افتراضي

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

بعد زمان ... وحشتنا يا شيخ ....
__________________
Monzer Osama
Saudia Arabia - Jeddah
00966501826235
Microsoft Certified Business Management Solutions Professional
Microsoft Certified Trainer
Monzer Osama غير متواجد حالياً   رد مع اقتباس
قديم 06-Sep-2011, 05:58 AM   #5
عبدالله عمر علي
عضو جديد
 
تاريخ التسجيل: Sep 2007
المشاركات: 1
من مواضيعي  
 

افتراضي

شكرا لكم
مع تحياتي لك العاملين على البرامج
عبدالله عمر علي
عبدالله عمر علي غير متواجد حالياً   رد مع اقتباس
قديم 06-Sep-2011, 03:36 PM   #6
Hafandi
عضو نشيط
 
تاريخ التسجيل: Jun 2007
الدولة: Saudi Arabia
المشاركات: 56
من مواضيعي  
افتراضي

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

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

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

للأسف إلى الآن لم تضع مايكروسوفت أمر تفقيط للعربي كما هو لللغة الانجليزية
Hafandi غير متواجد حالياً   رد مع اقتباس
قديم 06-Sep-2011, 06:04 PM   #7
Monzer Osama
مدير عام منتديات جريت بلينز العربية
افتراضي

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

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

كود:
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
Saudia Arabia - Jeddah
00966501826235
Microsoft Certified Business Management Solutions Professional
Microsoft Certified Trainer

آخر تعديل بواسطة Monzer Osama ، 06-Sep-2007 الساعة 06:51 PM.
Monzer Osama غير متواجد حالياً   رد مع اقتباس
قديم 06-Sep-2011, 06:05 PM   #8
Monzer Osama
مدير عام منتديات جريت بلينز العربية
افتراضي تكملة الكود

كود:
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]
__________________
Monzer Osama
Saudia Arabia - Jeddah
00966501826235
Microsoft Certified Business Management Solutions Professional
Microsoft Certified Trainer

آخر تعديل بواسطة Monzer Osama ، 06-Sep-2007 الساعة 06:52 PM.
Monzer Osama غير متواجد حالياً   رد مع اقتباس
قديم 06-Sep-2011, 06:53 PM   #9
Hafandi
عضو نشيط
 
تاريخ التسجيل: Jun 2007
الدولة: Saudi Arabia
المشاركات: 56
من مواضيعي  
افتراضي

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

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

ولكن الحسرة هو عدم اهتمام مايكروسوفت بتوفير دعم هذا التفقيط مثل التفقيط الانجليزي ، مع كبر حجم سوق gp في المنطقة
Hafandi غير متواجد حالياً   رد مع اقتباس
قديم 03-Nov-2011, 08:14 AM   #10
yousif1
عضو جديد
 
تاريخ التسجيل: Sep 2007
المشاركات: 12
من مواضيعي  
 

افتراضي

مشكووووووووووووووووووووور
yousif1 غير متواجد حالياً   رد مع اقتباس
إضافة رد


يتصفح الموضوع حالياً : 4 (0 عضو و 4 ضيف)
 
أدوات الموضوع
انواع عرض الموضوع

ضوابط المشاركة
لا تستطيع إضافة مواضيع جديدة
لا تستطيع الرد على المواضيع
لا يمكنك اضافة مرفقات
لا يمكنك تعديل مشاركاتك

BB code متاحة
كود [IMG] متاحة
كود HTML معطلة

الانتقال السريع

المواضيع المتشابهه
الموضوع كاتب الموضوع المنتدى مشاركات آخر مشاركة
الكتابة باللغة العربية Hassanb منتدى الإقتراحات والشكاوي 3 02-Dec-2014 10:18 AM
دروس تعليم الكريستال ريبورت 10 باللغة العربية Monzer Osama أدوات التقارير التي لا تنتمي لبرنامج جريت بلينز 26 04-Oct-2014 12:52 AM
دليل استخدام باللغة العربية yahiaz تعرف على جريت بلينز .... 7 26-Dec-2013 04:13 PM
عرض تقديمي لجريت بلينز باللغة العربية osamamakled منتدى جريت بلينز العام 7 01-Aug-2013 10:16 AM
سؤال عن دليل استخدام جريت بلينز10 باللغة العربية ( أرجو المساعدة ah_toybi الجزيئ المالي
(GL - AP - AR – BM - FA - AC ... ets.)
2 11-Jul-2013 02:00 AM


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


Powered by vBulletin® Version 3.8.3

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

Copyright © 2000-2010 Jelsoft Enterprises Limited.
الموقع لا يمثل أي جهة رسمية بل هو جهد شخصي يرمي الى تجميع القدرات في برنامج جريت بلينز