[kezzat]

(26-06-19, 04:12 PM)bassant كتب : السلام عليكم 

اريد اظهار التفقيط فقط في التقرير حيث لدي مثلا فيلد لمبلغ اريد عمل تفقيط له في الكريستال ريبورت حيث لا اريد عمل فيلد خاص بالتفقيط لهذا المبلغ به في الجدول توفيرا لحجم الداتا
فكيف اقوم بعمل التفقيط في التقرير فقط

شكرا جزيلا

وعليكم السلام
ضع في Report Custom Functions
يظهر

كود :

    Function NumberToText(Amount As Double, MainCurrency As String, SubCurrency As String)
        Dim Array1(10) As String
        Dim Array2(10) As String
        Dim Array3(10) As String
        Dim MyNumber As String
        Dim GetNumber As String
        Dim ReadNumber As Number
        Dim My100 As String
        Dim My10 As String
        Dim My1 As String
        Dim My11 As String
        Dim My12 As String
        Dim GetText As String
        Dim Billion As String
        Dim Million As String
        Dim Thousand As String
        Dim Hundred As String
        Dim Fraction As String
        Dim MyAnd As String
        Dim I As Number
        Dim ReMark As String


        If Amount > 999999999999.99 Then 
            Exit Function
        End If
        If Amount < 0 Then
            Amount = Amount * -1
            ReMark = "سالب "
        End If

        If Amount = 0 Then
            NumberToText = "صفر"
            Exit Function
        End If

        MyAnd = " و"
        Array1(1) = ""
        Array1(2) = "مائة"
        Array1(3) = "مائتان"
        Array1(4) = "ثلاثمائة"
        Array1(5) = "أربعمائة"
        Array1(6) = "خمسمائة"
        Array1(7) = "ستمائة"
        Array1(8) = "سبعمائة"
        Array1(9) = "ثمانمائة"
        Array1(10) = "تسعمائة"

        Array2(1) = ""
        Array2(2) = " عشر"
        Array2(3) = "عشرون"
        Array2(4) = "ثلاثون"
        Array2(5) = "أربعون"
        Array2(6) = "خمسون"
        Array2(7) = "ستون"
        Array2(8) = "سبعون"
        Array2(9) = "ثمانون"
        Array2(10) = "تسعون"

        Array3(1) = ""
        Array3(2) = "واحد"
        Array3(3) = "اثنان"
        Array3(4) = "ثلاثة"
        Array3(5) = "أربعة"
        Array3(6) = "خمسة"
        Array3(7) = "ستة"
        Array3(8) = "سبعة"
        Array3(9) = "ثمانية"
        Array3(10) = "تسعة"

        GetNumber = ToText(Amount, "000000000000.00")

        I = 0
        Do While I < 15

            If I < 12 Then
                MyNumber = Mid(GetNumber, I + 1, 3)
            Else
                MyNumber = "0" + Mid(GetNumber, I + 2, 2)
            End If

            If ToNumber(Mid(MyNumber, 1, 3)) > 0 Then

                ReadNumber = ToNumber(Mid(MyNumber, 1, 1))
                My100 = Array1(ReadNumber+1)
                ReadNumber = ToNumber(Mid(MyNumber, 3, 1))
                My1 = Array3(ReadNumber+1)
                ReadNumber = ToNumber(Mid(MyNumber, 2, 1))
                My10 = Array2(ReadNumber+1)

                If Mid(MyNumber, 2, 2) = "11" Then
                    My11 = "إحدى عشرة"
                End If
                If Mid(MyNumber, 2, 2) = "12" Then
                    My12 = "إثنى عشرة"
                End If
                If Mid(MyNumber, 2, 2) = "10" Then
                    My10 = "عشرة"
                End If

                If (ToNumber((Mid(MyNumber, 1, 1))) > 0) And (ToNumber((Mid(MyNumber, 2, 2))) > 0) Then
                    My100 = My100 + MyAnd
                End If
                If (ToNumber(Mid(MyNumber, 3, 1)) > 0) And (ToNumber(Mid(MyNumber, 2, 1)) > 1) Then
                    My1 = My1 + MyAnd
                End If

                GetText = My100 + My1 + My10

                If (ToNumber(Mid(MyNumber, 3, 1)) = 1) And (ToNumber(Mid(MyNumber, 2, 1)) = 1) Then
                    GetText = My100 + My11
                    If (ToNumber(Mid(MyNumber, 1, 1)) = 0) Then
                        GetText = My11
                    End If
                End If

                If (ToNumber(Mid(MyNumber, 3, 1)) = 2) And (ToNumber(Mid(MyNumber, 2, 1)) = 1) Then
                    GetText = My100 + My12
                    If (ToNumber(Mid(MyNumber, 1, 1)) = 0) Then
                        GetText = My12
                    End If
                End If

                If (I = 0) And (GetText <> "") Then
                    If (ToNumber(Mid(MyNumber, 1, 3)) > 10) Then
                        Billion = GetText + " مليار"
                    Else
                        Billion = GetText + " مليارات"
                        If (ToNumber(Mid(MyNumber, 1, 3)) = 2) Then
                            Billion = " مليار"
                        End If
                        If (ToNumber(Mid(MyNumber, 1, 3)) = 2) Then
                            Billion = " مليارن"
                        End If
                    End If
                End If

                If (I = 3) And (GetText <> "") Then

                    If (ToNumber(Mid(MyNumber, 1, 3)) > 10) Then
                        Million = GetText + " مليون"
                    Else
                        Million = GetText + " ملايين"
                        If (ToNumber(Mid(MyNumber, 1, 3)) = 1) Then
                            Million = " مليون"
                        End If
                        If (ToNumber(Mid(MyNumber, 1, 3)) = 2) Then
                            Million = " مليونان"
                        End If
                    End If
                End If

                If (I = 6) And (GetText <> "") Then
                    If (ToNumber(Mid(MyNumber, 1, 3)) > 10) Then
                        Thousand = GetText + " ألف"
                    Else
                        Thousand = GetText + " ألاف"
                        If (ToNumber(Mid(MyNumber, 3, 1)) = 1) Then
                            Thousand = " ألف"
                        End If
                        If (ToNumber(Mid(MyNumber, 3, 1)) = 2) Then
                            Thousand = " ألفان"
                        End If
                    End If
                End If

                If (I = 9) And (GetText <> "") Then
                    Hundred = GetText
                End If
                If (I = 12) And (GetText <> "") Then
                    Fraction = GetText
                End If
            End If

            I = I + 3
        Loop

        If (Billion <> "") Then
            If (Million <> "") Or (Thousand <> "") Or (Hundred <> "") Then
                Billion = Billion + MyAnd
            End If
        End If

        If (Million <> "") Then
            If (Thousand <> "") Or (Hundred <> "") Then
                Million = Million + MyAnd
            End If
        End If

        If (Thousand <> "") Then
            If (Hundred <> "") Then 
                Thousand = Thousand + MyAnd
            End If
        End If

        If Fraction <> "" Then
            If (Billion <> "") Or (Million <> "") Or (Thousand <> "") Or (Hundred <> "") Then
                NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency + MyAnd + Fraction + " " + SubCurrency
            Else
                NumberToText = ReMark + Fraction + " " + SubCurrency
            End If
        Else
            NumberToText = ReMark + Billion + Million + Thousand + Hundred + " " + MainCurrency
        End If
    End Function

ثم استعملها هكذا

كود :

 NumberToText (5431.24  ,"جنيه","قرش")

شكرا