اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

salimboub24

02 الأعضاء
 عرض الملف الشخصي  عرض المشاركات

  • Posts

    61

  • تاريخ الانضمام

  • تاريخ اخر زياره

 نوع المحتوي 

مشاركات المكتوبه بواسطه salimboub24

    شرح دوال اكسس

    في قسم الأكسيس Access

    قام بنشر · تم تعديل بواسطه salimboub24

    في ٩‏/٤‏/٢٠١٥ at 20:19, ابا جودى said:

    عرفة من قبل المستخدم

    السلام عليكم أريد دالة في قناع الادخال الاكسس حيث عندما أكتب  في بداية الكلمة حرف B أو حرف A لايقبل التخزين بحيث يقبل جميع الحروف في البداية ماعدا التي دكرتها A ,B و يعطيني رسالة خطأ أكتبها أنا 

    المساعدة في تفقيط الأرقام بالدينار

    في قسم الأكسيس Access

    قام بنشر

    في ٣٠‏/١‏/٢٠١٨ at 16:20, slamco2000 said:

    مشكلته ايضا قراءة الأرقام بعد الفاصلة العشرية

    لقراءة العدد : 1.235

    إنظر لقراءته : one and 0.235000

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

    للأسف لم أستطع إرفاق الملف بسبب الحجم ونسختها بالأسفل

    هذه قراءته : One Dinar And 235/Fils Only

    للفائدة لعل أحد يستفيد منها

    وألف شكر لك أخي

     

    Function English(ByVal N As Currency) As String
        Const Thousand = 1000@
        Const Million = Thousand * Thousand
        Const Billion = Thousand * Million
        Const Trillion = Thousand * Billion

        If (N = 0@) Then English = "Zero": Exit Function

        Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = ""
        Dim Frac As Currency: Frac = Abs(N - Fix(N))
        If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))
        Dim AtLeastOne As Integer: AtLeastOne = N >= 1

        If (N >= Trillion) Then
            Debug.Print N
            Buf = Buf & EnglishDigitGroup(Int(N / Trillion)) & " Trillion"
            N = N - Int(N / Trillion) * Trillion ' Mod overflows
            If (N >= 1@) Then Buf = Buf & " "
        End If
        
        If (N >= Billion) Then
            Debug.Print N
            Buf = Buf & EnglishDigitGroup(Int(N / Billion)) & " Billion"
            N = N - Int(N / Billion) * Billion ' Mod still overflows
            If (N >= 1@) Then Buf = Buf & " "
        End If

        If (N >= Million) Then
            Debug.Print N
            Buf = Buf & EnglishDigitGroup(N \ Million) & " Million"
            N = N Mod Million
            If (N >= 1@) Then Buf = Buf & " "
        End If

        If (N >= Thousand) Then
            Debug.Print N
            Buf = Buf & EnglishDigitGroup(N \ Thousand) & " Thousand"
            N = N Mod Thousand
            If (N >= 1@) Then Buf = Buf & " "
        End If

        If (N >= 1@) Then
            Debug.Print N
            Buf = Buf & EnglishDigitGroup(N)
        End If

        If (Frac = 0@) Then
            Buf = Buf & " Dinar Only"
        ElseIf (Int(Frac * 100@) = Frac * 100@) Then
            If AtLeastOne Then Buf = Buf & " And "
            Buf = Buf & Format$(Frac * 100@, "00") & "/100"
        Else
            If AtLeastOne Then Buf = Buf & " Dinar And "
            Buf = Buf & Format$(Frac * 1000@, "000") & "/Fils Only"
        End If

        English = Buf
    End Function

    ' Support function to be used only by English()
    Private Function EnglishDigitGroup(ByVal N As Integer) As String
        Const Hundred = " Hundred"
        Const One = "One"
        Const Two = "Two"
        Const Three = "Three"
        Const Four = "Four"
        Const Five = "Five"
        Const Six = "Six"
        Const Seven = "Seven"
        Const Eight = "Eight"
        Const Nine = "Nine"
        Dim Buf As String: Buf = ""
        Dim Flag As Integer: Flag = False

        'Do hundreds
        Select Case (N \ 100)
        Case 0: Buf = "":  Flag = False
        Case 1: Buf = One & Hundred: Flag = True
        Case 2: Buf = Two & Hundred: Flag = True
        Case 3: Buf = Three & Hundred: Flag = True
        Case 4: Buf = Four & Hundred: Flag = True
        Case 5: Buf = Five & Hundred: Flag = True
        Case 6: Buf = Six & Hundred: Flag = True
        Case 7: Buf = Seven & Hundred: Flag = True
        Case 8: Buf = Eight & Hundred: Flag = True
        Case 9: Buf = Nine & Hundred: Flag = True
        End Select
       
        If (Flag <> False) Then N = N Mod 100
        If (N > 0) Then
            If (Flag <> False) Then Buf = Buf & " "
        Else
            EnglishDigitGroup = Buf
            Exit Function
        End If
          
        'Do tens (except teens)
        Select Case (N \ 10)
        Case 0, 1: Flag = False
        Case 2: Buf = Buf & "Twenty": Flag = True
        Case 3: Buf = Buf & "Thirty": Flag = True
        Case 4: Buf = Buf & "Forty": Flag = True
        Case 5: Buf = Buf & "Fifty": Flag = True
        Case 6: Buf = Buf & "Sixty": Flag = True
        Case 7: Buf = Buf & "Seventy": Flag = True
        Case 8: Buf = Buf & "Eighty": Flag = True
        Case 9: Buf = Buf & "Ninety": Flag = True
        End Select
       
        If (Flag <> False) Then N = N Mod 10
        If (N > 0) Then
            If (Flag <> False) Then Buf = Buf & "-"
        Else
            EnglishDigitGroup = Buf
            Exit Function
        End If
        
        'Do ones and teens
        Select Case (N)
        Case 0: ' do nothing
        Case 1: Buf = Buf & One
        Case 2: Buf = Buf & Two
        Case 3: Buf = Buf & Three
        Case 4: Buf = Buf & Four
        Case 5: Buf = Buf & Five
        Case 6: Buf = Buf & Six
        Case 7: Buf = Buf & Seven
        Case 8: Buf = Buf & Eight
        Case 9: Buf = Buf & Nine
        Case 10: Buf = Buf & "Ten"
        Case 11: Buf = Buf & "Eleven"
        Case 12: Buf = Buf & "Twelve"
        Case 13: Buf = Buf & "Thirteen"
        Case 14: Buf = Buf & "Fourteen"
        Case 15: Buf = Buf & "Fifteen"
        Case 16: Buf = Buf & "Sixteen"
        Case 17: Buf = Buf & "Seventeen"
        Case 18: Buf = Buf & "Eighteen"
        Case 19: Buf = Buf & "Nineteen"
        End Select

        EnglishDigitGroup = Buf
    End Function

    ال

    السلام عليكم أخي اذا امكن أريده باللغة الفرنسية

    تفقيط مبلغ في تقرير

    في قسم الأكسيس Access

    قام بنشر

    في ١٩‏/٣‏/٢٠١٩ at 16:07, كريمو2 said:

    جرب هذا  اخي salimboub24 وانسخها في الوحدة النمطية بإسم مثلا "convertir-chiffres-lettres" واستدعي الدالة 

    
=NbEnLettres([مربع النص الذي به المبلغ في التقرير];"DA";"cm") & " "
    
Public Function ConvertNbLettres(NB, DA As String) As String

Dim varnum, varnumD, varnumU, resultat, varlet
Static chiffre(1 To 19)
chiffre(1) = "un"
chiffre(2) = "deux"
chiffre(3) = "trois"
chiffre(4) = "quatre"
chiffre(5) = "cinq"
chiffre(6) = "six"
chiffre(7) = "sept"
chiffre(8) = "huit"
chiffre(9) = "neuf"
chiffre(10) = "dix"
chiffre(11) = "onze"
chiffre(12) = "douze"
chiffre(13) = "treize"
chiffre(14) = "quatorze"
chiffre(15) = "quinze"
chiffre(16) = "seize"
chiffre(17) = "dix-sept"
chiffre(18) = "dix-huit"
chiffre(19) = "dix-neuf"
Static dizaine(1 To 8)
dizaine(1) = "dix"
dizaine(2) = "vingt"
dizaine(3) = "trente"
dizaine(4) = "quarante"
dizaine(5) = "cinquante"
dizaine(6) = "soixante"
dizaine(8) = "quatre-vingt"

'traitement du cas 0 frs
If NB >= 1 Then
resultat = ""
Else
resultat = "zéro"
GoTo fintraitementfrancs
End If

'traitement des millions
varnum = Int(NB / 1000000)
If varnum > 0 Then
GoSub centaine_dizaine
resultat = varlet + " million"
If varlet <> "un" Then: resultat = resultat + "s"
End If

'traitement des milliers
varnum = Int(NB) Mod 1000000
varnum = Int(varnum / 1000)
If varnum > 0 Then
GoSub centaine_dizaine
If varlet <> "un" Then: resultat = resultat + " " + varlet
resultat = resultat + " mille"
End If

'traitement des centaines et dizaines
varnum = Int(NB) Mod 1000
If varnum > 0 Then
GoSub centaine_dizaine
resultat = resultat + " " + varlet
End If
resultat = LTrim(resultat)
varlet = Right$(resultat, 4)

'traitement du "s" final pour vingt et cent et du "de" pour million
Select Case varlet
Case "cent", "ingt"
resultat = resultat + "s"
Case "lion", "ions"
resultat = resultat + " de"
End Select

fintraitementfrancs:
resultat = resultat + " " + DA
If NB > 2 Then: resultat = resultat + "s"

'traitement des centimes
varnum = Int((NB - Int(NB)) * 100 + 0.5)
If varnum > 0 Then
GoSub centaine_dizaine
resultat = resultat + " et " + varlet + " centime"
If varnum > 1 Then: resultat = resultat + "s"
End If

' conversion 1ère lettre en majuscule
resultat = UCase(Left(resultat, 1)) + Right(resultat, Len(resultat) - 1)

'renvoi du resultat de la fonction et fin de la fonction
ConvertNbLettres = resultat
Exit Function

'sous programme
centaine_dizaine:

varlet = ""

'traitement des centaines
If varnum >= 100 Then
varlet = chiffre(Int(varnum / 100))
varnum = varnum Mod 100
If varlet = "un" Then
varlet = "cent "
Else
varlet = varlet + " cent "
End If
End If

'traitement des dizaines
If varnum <= 19 Then
If varnum > 0 Then: varlet = varlet + chiffre(varnum)
Else
varnumD = Int(varnum / 10)
varnumU = varnum Mod 10
Select Case varnumD
Case Is <= 5
varlet = varlet + dizaine(varnumD)
Case 6, 7
varlet = varlet + dizaine(6)
Case 8, 9
varlet = varlet + dizaine(8)
End Select
If varnumU = 1 And varnumD < 8 Then
varlet = varlet + " et "
Else
If varnumU <> 0 Or varnumD = 7 Or varnumD = 9 Then: varlet = varlet
+ " "
End If
If varnumD = 7 Or varnumD = 9 Then: varnumU = varnumU + 10
If varnumU <> 0 Then: varlet = varlet + chiffre(varnumU)
End If
varlet = RTrim(varlet)
Return

End Function

     

    السلام عليكم أخي اذا امكنك أريد مثال للتحميل

    HELP

    في قسم الأكسيس Access

    قام بنشر

    في ١٧‏/٣‏/٢٠١٩ at 18:00, خالد سيسكو said: 
    
=NoToText([x1])

    اخي العزيز 

    هذه وحده نمطية لتحويل الارقام الى حروف

    وقم باستدعائها بالكود الموجود =NoToText([x1])

    Convert Nuber to text.rar 1.13 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 6 downloads

    ياأخي اذا امكنك اريده بالفرنسية مثلا 1200 mille deux centBase de données11.accdb

    Base de données11.accdb

    تفقيط مبلغ في تقرير

    في قسم الأكسيس Access

    قام بنشر

    في ١٩‏/٣‏/٢٠١٩ at 16:07, كريمو2 said:

    =NbEnLettres([مربع النص الذي به المبلغ في التقرير];"DA";"cm") & " "

     شكرا لك أخي هذه العملية لم تصلح 

    لقد ارسلت لك ملف  البرنامج كاملا حمله وارجو ان تقوم بالتعديل عليه 

    لاحظ أخي في الاسفل المبلغ مكتوب 192000.00 هة فيه خطأ 

    لانني قمت بترجمة ملف التفقيط قديم بالانجليزيى

     

    image.png.f4d7c7e76c758563db4b14ae3d145ee8.png

    image.png

    ORDRE DE VERSEMENT.rar

×
×
  • اضف...

Important Information

  I accept