كيفية إستدعاء دالة في الإستعلام

[عبدالقدوس48]

كيفية إستدعاء دالة الفرق بين تارخين في الإستعلام إليكم الدالة

Function Calcdiffy(vdate1 As Date, vdate2 As Date)
Dim vyears As Integer, vMonths As Integer, vDays As Integer
vMonths = DateDiff("m", vdate1, vdate2)
vDays = DateDiff("d", DateAdd("m", vMonths, vdate1), vdate2)
If vDays < 0 Then
    vMonths = vMonths - 1
    vDays = DateDiff("d", DateAdd("m", vMonths, vdate1), vdate2)
End If
vyears = vMonths \ 12
vMonths = vMonths Mod 12
Calcdiffy = vyears
End Function

Function CalcdiffM(vdate1 As Date, vdate2 As Date)
Dim vyears As Integer, vMonths As Integer, vDays As Integer
vMonths = DateDiff("m", vdate1, vdate2)
vDays = DateDiff("d", DateAdd("m", vMonths, vdate1), vdate2)
If vDays < 0 Then
    vMonths = vMonths - 1
    vDays = DateDiff("d", DateAdd("m", vMonths, vdate1), vdate2)
End If
vyears = vMonths \ 12
vMonths = vMonths Mod 12
CalcdiffM = vMonths
End Function

Function CalcdiffD(vdate1 As Date, vdate2 As Date)
Dim vyears As Integer, vMonths As Integer, vDays As Integer
vMonths = DateDiff("m", vdate1, vdate2)
vDays = DateDiff("d", DateAdd("m", vMonths, vdate1), vdate2)
If vDays < 0 Then
    vMonths = vMonths - 1
    vDays = DateDiff("d", DateAdd("m", vMonths, vdate1), vdate2)
End If
vyears = vMonths \ 12
vMonths = vMonths Mod 12
CalcdiffD = vDays
End Function

 

 

تم تعديل نوفمبر 9, 2021 بواسطه jjafferr
إظهار الكود بالطريقة الصحيحة بإستعمال زر <> من القائمة

[Moosak]

تكتب اسم الدالة في منشئ التعبير هكذا :

Calcdiffy(vdate1 As Date, vdate2 As Date)

بعدها تقوم بوضع المتغيرات ..  vdate1 و vdate2

[عبدالقدوس48]

شكرا على سرعة الرد جزاك الله كل خير وبارك فيك

 

[jjafferr]

بتغيير بسيط على كود اخوي موسى ، ليتماشى مع الاستعلام :

DD: Calcdiffy([vdate1], [vdate2])

 

جعفر

[عبدالقدوس48]

ملف ليتم التعديل عليه 

فرق التاريخ.accdb

للعلم على الاستعلام

[Eng.Qassim]

20 دقائق مضت, عبدالقدوس48 said:

ملف ليتم التعديل عليه

تفضل عزيزي

 

فرق التاريخ1.accdb

[عبدالقدوس48]

شكرا لكم أخوتي وجزاكم الله خيرا

[jjafferr]

طيب ايش رأيك بهذه النتيجة : 2س/1ش/0ي  = 2 سنه/1 شهر/ 0 يوم :

 

 

وهذه هي الدالة:

Public Function YMDDif4(sDate1, sDate2)
On Error GoTo err_YMDDif4


    'sDate1 earliest date
    'sDate2 later date
    
    Dim D As Integer, m As Integer, y As Integer
    
    Dim iYear As Integer
    Dim iMonth As Integer
    Dim iDay As Integer
    Dim dInterim1 As Date
    
    iMonth = DateDiff("m", sDate1, sDate2)
        
    If Day(sDate1) > Day(sDate2) Then
        iMonth = iMonth - 1
    End If
    
    dInterim1 = DateAdd("m", iMonth, sDate1)
    iDay = DateDiff("d", dInterim1, sDate2)
    
    D = iDay
    m = iMonth Mod 12
    y = iMonth \ 12
    'YMDDif2 = CStr(Y) & " Years " & CStr(M) & " months " & CStr(D) & " days"
    YMDDif4 = CStr(y) & " س/" & CStr(m) & " ش/" & CStr(D) & " ي"

Exit Function
err_YMDDif4:

    If Err.Number = 94 Then
        'ignor, null
        Resume Next
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If
    
End Function

 

جعفر

[عبدالقدوس48]

دالة رائعة أخي

تفضل 

http://www.accessallinone.com/access-2013-no-vba-downloads/