استخراج كلمتي : صباح ومساء بناء على AM و PM

[ابوخليل]

السلام عليكم

انا استخدم هذا السطر لاستخراج كلمة الصباح ... ومثله للمساء من التاريخ الكامل

مراعيا تنسيقات المستخدم للتاريخ ان كان عربي او غيره

IIf(Mid([chekin];20;1)="م" Or Mid([chekin];20;2)="PM";"المساء";IIf(Mid([chekin];20;1)="ص" Or Mid([chekin];20;2)="AM";"الصباح";""))

ولكن احيانا يختلف عدد حروف التاريخ  بناء على الساعات اليومية

هل من طريقة احكم واضبط  استخدمها في الاستعلام ؟

اعني هل هناك دالة تتعرف على الوقت هل هو صباح ام مساء  بمجرد تمرير التاريخ اليها ؟

[ابو جودي]

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

طبعا ممكن من خلال الكود التالى 

 

Public Function GetTimePeriod(ByVal varDateTime As Variant) As String
    On Error GoTo ErrHandler

    If IsNull(varDateTime) Or varDateTime = "" Then
        GetTimePeriod = ""
        Exit Function
    End If

    Dim dtmTime As Date
    dtmTime = CDate(varDateTime)

    Dim lngHour As Long
    lngHour = Hour(dtmTime)

    If lngHour < 12 Then
        GetTimePeriod = "الصباح"
    Else
        GetTimePeriod = "المساء"
    End If

    Exit Function
ErrHandler:
    GetTimePeriod = ""
End Function

وللاستدعاء

GetTimePeriod([CheckIn])

 

[ابوخليل]

اهلا ابا جودي

اصغر من 12 = الصباح

الساعة الآن  11:05

هل نحن في الصباح ؟

[ابو جودي]

لا نحن فى المساء

والكود يعمل عندى بنجاح
 

الدالة التي تعتمد على Hour() ترجع عددا صحيحا من 0 إلى 23

لذلك Hour(11:59) = 11   >>-->  الصباح
و Hour(12:00) = 12        >>-->  المساء

 

وللتجربة

Public Sub Test_GetTimePeriod()
    Dim arrTimes As Variant
    Dim i As Long
    Dim dtmSample As Date
    Dim strResult As String
    
    arrTimes = Array( _
        "00:00", _
        "05:30", _
        "11:59", _
        "12:00", _
        "12:05 AM", _
        "12:05 PM", _
        "12:01", _
        "13:45", _
        "17:00", _
        "23:59" _
    )
    
    Debug.Print "-----------------------------"
    Debug.Print "الوقت" & vbTab & ">>->" & vbTab & "الفترة"
    Debug.Print "-----------------------------"
    
    For i = LBound(arrTimes) To UBound(arrTimes)
        dtmSample = TimeValue(arrTimes(i))
        strResult = GetTimePeriod(dtmSample)
        Debug.Print Format(dtmSample, "hh:nn AM/PM") & vbTab & " >>-> " & vbTab & strResult
    Next i
End Sub

 

[ناقل]

21 دقائق مضت, ابوخليل said:

انا استخدم هذا السطر لاستخراج كلمة الصباح ... ومثله للمساء من التاريخ الكامل

جرب هذه الدالة

IIf(Hour([chekin]) < 12, "الصباح", "المساء")

لم اجربها ...

[ابوخليل]

تمام  باشمهندس .. جربتها الآن تعمل 100%

الف شكر .. على الخدمات السريعة

ما بين نشري للسؤال وحصولي على الاجابة 5 دقائق فقط 

دمت ذخرا لإخوانك ولمرتادي هذا المنتدى .. وكتب لك الأجر

[ابو جودي]

4 دقائق مضت, ناقل said:

جرب هذه الدالة

IIf(Hour([chekin]) < 12, "الصباح", "المساء")

لم اجربها ...

كلام حضرتك صح جدا جدا
انا فقط افضل الكود فى وحدة نمطية لاستخدامه فى اى مكان 

وتوفيرا للعناء 

[ناقل]

2 دقائق مضت, ابو جودي said:

كلام حضرتك صح جدا جدا
انا فقط افضل الكود فى وحدة نمطية لاستخدامه فى اى مكان 

وتوفيرا للعناء

ممكن كده

Public Function GetPeriod(dt As Date) As String
    If Hour(dt) < 12 Then
        GetPeriod = "الصباح"
    Else
        GetPeriod = "المساء"
    End If
End Function

 

[ابوخليل]

5 دقائق مضت, ناقل said:

جرب هذه الدالة

IIf(Hour([chekin]) < 12, "الصباح", "المساء")

لم اجربها ...

جزيت خيرا اخي ناقل .. السطر يتحدث عن نفسه .. سوف اجربه

انا حريص على عدم وجود ثغرات .. خاصة وان التاريخ عرضة للتغير بسبب تنسيقات وندوز ... عربي /انجليزي /ونظام 12 و 24

لذا اعتقد ان كلمة السر في كود ابي جودي هي هذا السطر :

dtmTime = CDate(varDateTime)

 

[ابو جودي]

طيب ايه الفرق بين

Public Function GetTimePeriod(ByVal varDateTime As Variant) As String

Public Function GetPeriod(dt As Date) As String

GetTimePeriod أكثر أمانا ومرونة لان

• الوسيط Variant بعكس الوسيط Date صارم
• التحقق من Null أو ""
• التحويل إلى تاريخ باستخدام CDate
• يدعم Null / نصوص صالحة للتحويل
• مناسب للاستخدام من النماذج / الحقول مباشرة

[ابو جودي]

18 دقائق مضت, ابوخليل said:

انا حريص على عدم وجود ثغرات .. خاصة وان التاريخ عرضة للتغير بسبب تنسيقات وندوز ... عربي /انجليزي /ونظام 12 و 24

 

بالنسبة للدالة Hour بهذا الشكل

IIf(Hour([chekin]) < 12, "الصباح", "المساء")

هذا السطر لا يتأثر بالتنسيق الإقليمي للنظام طالما أن الحقل [chekin] يحتوي فعليا على قيمة من النوع Date/Time
 

لماذا لا يتأثر؟

• الدالة Hour(...) تعتمد على القيمة الداخلية للوقت المخزن في Access وليس على الشكل المعروض
• Access يخزن التاريخ/الوقت كقيمة رقمية مزدوجة (Double) الجزء الصحيح للتاريخ والجزء الكسري للوقت
• نظام العرض (12/24 ساعة – AM/PM) يخص شكل العرض فقط بينما الدالة Hour() دائما ترجع رقم بين 0 و23 بغض النظر عن التنسيق

ولكن ماذا لو كان نوع البيانات للحقل نص وليس تاريخ
لابد من الاستخدام بالشكل التالى 

IIf(IsDate([chekin]) And Hour(CDate([chekin])) < 12, "الصباح", "المساء")

[ابو جودي]

منذ ساعه, ابوخليل said:

حريص على عدم وجود ثغرات .. خاصة وان التاريخ عرضة للتغير بسبب تنسيقات وندوز ... عربي /انجليزي /ونظام 12 و 24

وبسبب هذه الجملة اعيد صياغة الكود فى الوحدة النمطية العامة ليكون بهذا الشكل لاضافة قاموس لدعم اللغات المتعددة واضافة الاختصارات او الخطاء الشائعة او الممكنة فى المستقبل

 

Public Function GetTimePeriod(ByVal varDateTime As Variant) As String
    On Error GoTo ErrHandler

    Const STR_MORNING As String = "الصباح"
    Const STR_EVENING As String = "المساء"

    If IsMissing(varDateTime) Or IsNull(varDateTime) Then Exit Function
    If Len(Trim(Nz(varDateTime, ""))) = 0 Then Exit Function

    Dim strInput As String
    strInput = Trim(CStr(Nz(varDateTime, "")))

    ' استبدال التعابير المحلية أو الأجنبية بـ AM/PM
    Dim dicReplacements As Object
    Set dicReplacements = CreateObject("Scripting.Dictionary")

    With dicReplacements
        ' العربية
        .Add "ص", "AM"
        .Add "ص.", "AM"
        .Add "صباح", "AM"
        .Add "صباحا", "AM"
        .Add "صباحًا", "AM"
        .Add "صـ", "AM"
        .Add "صـباح", "AM"
        .Add "صباحاً", "AM"
    
        .Add "م", "PM"
        .Add "م.", "PM"
        .Add "مساء", "PM"
        .Add "مساءً", "PM"
        .Add "مسائا", "PM"
        .Add "مساءاً", "PM"
        .Add "مسائياً", "PM"
    
        ' الفرنسية
        .Add "matin", "AM"
        .Add "du matin", "AM"
        .Add "soir", "PM"
        .Add "du soir", "PM"
        .Add "après-midi", "PM"
    
        ' الألمانية
        .Add "vormittag", "AM"     ' قبل الظهر
        .Add "morgen", "AM"        ' الصباح
        .Add "morgens", "AM"       ' في الصباح
        .Add "nachmittag", "PM"    ' بعد الظهر
        .Add "abend", "PM"         ' المساء
        .Add "abends", "PM"        ' في المساء
        .Add "nachts", "PM"        ' ليلًا
    
        ' الإنجليزية - دعم إضافي لأنماط مكررة
        .Add "am", "AM"
        .Add "pm", "PM"
        .Add "a.m.", "AM"
        .Add "p.m.", "PM"
        .Add "a.m", "AM"
        .Add "p.m", "PM"
        .Add "A.M.", "AM"
        .Add "P.M.", "PM"
        .Add "A.M", "AM"
        .Add "P.M", "PM"
    End With


    Dim varKey As Variant
    For Each varKey In dicReplacements.Keys
        strInput = Replace(strInput, varKey, dicReplacements(varKey), , , vbTextCompare)
    Next varKey

    ' تنسيق الوقت (دمج من FixTimeFormat)
    Dim strSuffix As String
    Dim strTimeOnly As String
    Dim arrParts() As String

    If InStr(1, strInput, "AM", vbTextCompare) > 0 Then
        strSuffix = " AM"
        strTimeOnly = Replace(strInput, "AM", "", , , vbTextCompare)
    ElseIf InStr(1, strInput, "PM", vbTextCompare) > 0 Then
        strSuffix = " PM"
        strTimeOnly = Replace(strInput, "PM", "", , , vbTextCompare)
    Else
        strSuffix = ""
        strTimeOnly = strInput
    End If

    strTimeOnly = Trim(strTimeOnly)
    arrParts = Split(strTimeOnly, ":")

    If UBound(arrParts) >= 0 Then
        arrParts(0) = Format$(Val(arrParts(0)), "00")
    End If
    If UBound(arrParts) >= 1 Then
        arrParts(1) = Format$(Val(arrParts(1)), "00")
    Else
        ReDim Preserve arrParts(1)
        arrParts(1) = "00"
    End If

    strInput = Join(arrParts, ":") & strSuffix

    ' التحويل إلى وقت فعلي
    Dim dtmTime As Date
    dtmTime = CDate(strInput)

    Dim lngHour As Long
    lngHour = Hour(dtmTime)

    If lngHour < 12 Then
        GetTimePeriod = STR_MORNING
    Else
        GetTimePeriod = STR_EVENING
    End If

    Exit Function

ErrHandler:
    GetTimePeriod = ""
End Function

 

[ابوخليل]

بارك الله فيكم

نعم الحقل نصي تاريخ ام القرى كامل 

لذا ذهبت الى عد الحروف .. ولظهور بعض الأخطاء طرحت سؤالي هنا .

وتحويل النص الى تاريخ فكرة جيدة . وكنت اتحاشاها لوجود تعارض بين الهجري  والميلادي في يوم او يومين من كل سنة

ولهذا اشرت الى  CDate(varDateTime)