نجوم المشاركات

السلام عليكم ورحمة الله تعالى وبركاته تحية طيبة عطرة موديول واحد قمت بتجميع الدوال الهامة للتاريخ بحيث يسهل استخدامها مع الاخذ فى الاعتبار بمرونة التحكم الشامل فى كل كبيرة وصغيره بسم الله الرحمن الرحيم وعلى بركة الله طالما سوف نتطرق الى التاريخ والتعامل معه لابد أن نبدأ على خطى استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr واقتبس من استاذى الجليل تلك الكلمات التى لابد ان تعلق فى اذهان كل من يتعامل مع دوال والتاريخ الروتين رقم 1 DateFormat Function DateFormat(ByVal varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And [Date_Field]=" & DateFormat(The_Date_Field)) ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function الروتين رقم 2 ToWhat يقوم بعمل التحويل من التاريخ الميلادى الى الهجرى والعكس ولكن لابد من عمل جدول باسم tblAdjustHjriDate يحتوى على حقل رقمى باسم AdjustDay وذلك لوضع الفرق بالايام بين التاريخين حسب كل شهر للحصول على النتيجة الصحيحة ' ______ ______ .__ __. ____ ____ _______ .______ .___________. __ .__ __. _______ ' / | / __ \ | \ | | \ \ / / | ____|| _ \ | || | | \ | | / _____| ' | ,----'| | | | | \| | \ \/ / | |__ | |_) | `---| |----`| | | \| | | | __ ' | | | | | | | . ` | \ / | __| | / | | | | | . ` | | | |_ | ' | `----.| `--' | | |\ | \ / | |____ | |\ \----. | | | | | |\ | | |__| | ' \______| \______/ |__| \__| \__/ |_______|| _| `._____| |__| |__| |__| \__| \______| ' _______ ___ .___________. _______ _______ .______ ______ .___ ___. ' | \ / \ | || ____| | ____|| _ \ / __ \ | \/ | ' | .--. | / ^ \ `---| |----`| |__ | |__ | |_) | | | | | | \ / | ' | | | | / /_\ \ | | | __| | __| | / | | | | | |\/| | ' | '--' | / _____ \ | | | |____ | | | |\ \----.| `--' | | | | | ' |_______/ /__/ \__\ |__| |_______| |__| | _| `._____| \______/ |__| |__| ' _______ .______ _______ _______ ______ .______ __ ___ .__ __. .___________. ______ ' / _____|| _ \ | ____| / _____| / __ \ | _ \ | | / \ | \ | | | | / __ \ ' | | __ | |_) | | |__ | | __ | | | | | |_) | | | / ^ \ | \| | `---| |----`| | | | ' | | |_ | | / | __| | | |_ | | | | | | / | | / /_\ \ | . ` | | | | | | | ' | |__| | | |\ \----.| |____ | |__| | | `--' | | |\ \----.| | / _____ \ | |\ | | | | `--' | ' \______| | _| `._____||_______| \______| \______/ | _| `._____||__| /__/ \__\ |__| \__| |__| \______/ ' __ __ __ __ .______ __ ' | | | | | | | | | _ \ | | ' | |__| | | | | | | |_) | | | ' | __ | | | .--. | | | / | | ' | | | | | | | `--' | | |\ \----.| | ' |__| |__| |__| \______/ | _| `._____||__| ' ______ .______ .______ ___ ______ __ ___ ' / __ \ | _ \ | _ \ / \ / || |/ / ' | | | | | |_) | | |_) | / ^ \ | ,----'| ' / ' | | | | | / | _ < / /_\ \ | | | < ' | `--' | | |\ \----. | |_) | / _____ \ | `----.| . \ ' \______/ | _| `._____| |______/ /__/ \__\ \______||__|\__\ ' Public Function ToWhat(ByRef myData As String, To_Hijri_Milady As String) As String Dim CorctAdjustDay As Integer Dim SavedCal As Integer Dim strD As Date Dim strS As String On Error GoTo ErrorHandler 'to call the Function 'Hijri to Milady 'txt Milady date = ToWhat(txt Hijri date, "H") 'Milady to Hijri 'txt Hijri date = ToWhat(txt Milady date, "M") CorctAdjustDay = DLookup("[AdjustDay]", "tblAdjustHjriDate") If To_Hijri_Milady = "M" Then myData = Trim(Format(DateAdd("d", -1 * CorctAdjustDay, myData), "dd/mm/yyyy")) SavedCal = Calendar VBA.Calendar = 1 strD = CDate(myData) VBA.Calendar = 0 Else myData = Trim(Format(DateAdd("d", CorctAdjustDay, myData), "dd/mm/yyyy")) SavedCal = Calendar VBA.Calendar = 0 strD = CDate(myData) VBA.Calendar = 1 End If strS = CStr(strD) ToWhat = Format(strS, "dd/mm/yyyy") VBA.Calendar = SavedCal ErrorHandlerExit: Exit Function ErrorHandler: If Err = 13 Then MsgBox "Wrong Data", vbOKOnly + vbMsgBoxRight + vbMsgBoxRtlReading, "Wrong" Exit Function 'Resume Next Else Resume ErrorHandlerExit End If End Function الروتين رقم 3 MyNo للتحكم فى شكل ظهور الارقام بالعربية او بالهندية من خلال استخدام اليونيكود ' __ ___ .__ __. _______ __ __ ___ _______ _______ ______ _______ .__ __. __ __ .___ ___. .______ _______ .______ _______. ' | | / \ | \ | | / _____|| | | | / \ / _____|| ____| / __ \ | ____| | \ | | | | | | | \/ | | _ \ | ____|| _ \ / | ' | | / ^ \ | \| | | | __ | | | | / ^ \ | | __ | |__ | | | | | |__ | \| | | | | | | \ / | | |_) | | |__ | |_) | | (----` ' | | / /_\ \ | . ` | | | |_ | | | | | / /_\ \ | | |_ | | __| | | | | | __| | . ` | | | | | | |\/| | | _ < | __| | / \ \ ' | `----. / _____ \ | |\ | | |__| | | `--' | / _____ \ | |__| | | |____ | `--' | | | | |\ | | `--' | | | | | | |_) | | |____ | |\ \----..----) | ' |_______|/__/ \__\ |__| \__| \______| \______/ /__/ \__\ \______| |_______| \______/ |__| |__| \__| \______/ |__| |__| |______/ |_______|| _| `._____||_______/ ' Public Function MyNo(ByVal strNo As String, ByVal strLng As String) 'to call the Function 'To Arabic 'txtNoToAR=MyNo(txtNo,"Ar") 'To English 'txtNoTOEng=MyNo(txtNo,"En") If strLng = "Ar" Then strNo = Replace(strNo, ChrW(48), ChrW(1632)) strNo = Replace(strNo, ChrW(49), ChrW(1633)) strNo = Replace(strNo, ChrW(50), ChrW(1634)) strNo = Replace(strNo, ChrW(51), ChrW(1635)) strNo = Replace(strNo, ChrW(52), ChrW(1636)) strNo = Replace(strNo, ChrW(53), ChrW(1637)) strNo = Replace(strNo, ChrW(54), ChrW(1638)) strNo = Replace(strNo, ChrW(55), ChrW(1639)) strNo = Replace(strNo, ChrW(56), ChrW(1640)) strNo = Replace(strNo, ChrW(57), ChrW(1641)) MyNo = strNo ElseIf strLng = "En" Then strNo = Replace(strNo, ChrW(1632), ChrW(48)) strNo = Replace(strNo, ChrW(1633), ChrW(49)) strNo = Replace(strNo, ChrW(1634), ChrW(50)) strNo = Replace(strNo, ChrW(1635), ChrW(51)) strNo = Replace(strNo, ChrW(1636), ChrW(52)) strNo = Replace(strNo, ChrW(1637), ChrW(53)) strNo = Replace(strNo, ChrW(1638), ChrW(54)) strNo = Replace(strNo, ChrW(1639), ChrW(55)) strNo = Replace(strNo, ChrW(1640), ChrW(56)) strNo = Replace(strNo, ChrW(1641), ChrW(57)) MyNo = strNo End If End Function الروتين رقم 4 MnthName اسماء الشهور الهجرى - العربى( الميلادى) - الانجليزيى( الميلادى) - اختصارالانجليزيى( الميلادى) - القبطى - السريانى ' .__ __. ___ .___ ___. _______ _______. ______ _______ .___________. __ __ _______ .___ ___. ______ .__ __. .___________. __ __ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | || | | | | ____| | \/ | / __ \ | \ | | | || | | | / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ `---| |----`| |__| | | |__ | \ / | | | | | | \| | `---| |----`| |__| | | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | __ | | __| | |\/| | | | | | | . ` | | | | __ | \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | | | | | | | |____ | | | | | `--' | | |\ | | | | | | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |__| |__| |__| |_______| |__| |__| \______/ |__| \__| |__| |__| |__| |_______/ ' Public Function MnthName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Hijri 'txtMonthNameHijri =MnthName(txtDate,"HJ") 'To Arabic 'txtMonthNameArabic =MnthName(txtDate,"Ar") 'To English 'txtMonthNameEnglish =MnthName(txtDate,"En") 'To English Short 'txtMonthNameEnglish =MnthName(txtDate,"EnShrt") 'To Coptic 'txtMonthNameCoptic =MnthName(txtDate,"Cpti") 'To Syriac 'txtMonthNameSyriac =MnthName(txtDate,"Syr") Dim str01 As String Dim str02 As String Dim str03 As String Dim str04 As String Dim str05 As String Dim str06 As String Dim str07 As String Dim Str08 As String Dim Str09 As String Dim Str10 As String Dim Str11 As String Dim Str12 As String If strLng = "HJ" Then str01 = ChrW("1605") & ChrW("1581") & ChrW("1585") & ChrW("1605") str02 = ChrW("1589") & ChrW("1601") & ChrW("1585") str03 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") str04 = ChrW("1585") & ChrW("1576") & ChrW("1610") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") str05 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") & ChrW("1610") str06 = ChrW("1580") & ChrW("1605") & ChrW("1575") & ChrW("1583") & ChrW("1610") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1582") & ChrW("1585") & ChrW("1577") str07 = ChrW("1585") & ChrW("1580") & ChrW("1576") Str08 = ChrW("1588") & ChrW("1593") & ChrW("1576") & ChrW("1575") & ChrW("1606") Str09 = ChrW("1585") & ChrW("1605") & ChrW("1590") & ChrW("1575") & ChrW("1606") Str10 = ChrW("1588") & ChrW("1608") & ChrW("1575") & ChrW("1604") Str11 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1602") & ChrW("1593") & ChrW("1583") & ChrW("1577") Str12 = ChrW("1584") & ChrW("1608") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1581") & ChrW("1580") & ChrW("1577") ElseIf strLng = "Ar" Then str01 = ChrW("1610") & ChrW("1606") & ChrW("1575") & ChrW("1610") & ChrW("1585") str02 = ChrW("1601") & ChrW("1576") & ChrW("1585") & ChrW("1575") & ChrW("1610") & ChrW("1585") str03 = ChrW("1605") & ChrW("1575") & ChrW("1585") & ChrW("1587") str04 = ChrW("1571") & ChrW("1576") & ChrW("1585") & ChrW("1610") & ChrW("1604") str05 = ChrW("1605") & ChrW("1575") & ChrW("1610") & ChrW("1608") str06 = ChrW("1610") & ChrW("1608") & ChrW("1606") & ChrW("1610") & ChrW("1577") str07 = ChrW("1610") & ChrW("1608") & ChrW("1604") & ChrW("1610") & ChrW("1577") Str08 = ChrW("1571") & ChrW("1594") & ChrW("1587") & ChrW("1591") & ChrW("1587") Str09 = ChrW("1587") & ChrW("1576") & ChrW("1578") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str10 = ChrW("1575") & ChrW("1603") & ChrW("1578") & ChrW("1608") & ChrW("1576") & ChrW("1585") Str11 = ChrW("1606") & ChrW("1608") & ChrW("1601") & ChrW("1605") & ChrW("1576") & ChrW("1585") Str12 = ChrW("1583") & ChrW("1610") & ChrW("1587") & ChrW("1605") & ChrW("1576") & ChrW("1585") ElseIf strLng = "En" Then str01 = "January" str02 = "February" str03 = "March" str04 = "April" str05 = "May" str06 = "June" str07 = "July" Str08 = "August" Str09 = "September" Str10 = "October" Str11 = "November" Str12 = "December" ElseIf strLng = "EnShrt" Then str01 = "Jan" str02 = "Feb" str03 = "Mar" str04 = "Apr" str05 = "May" str06 = "Jun" str07 = "Jul" Str08 = "Aug" Str09 = "Sep" Str10 = "Oct" Str11 = "Nov" Str12 = "Dec" ElseIf strLng = "Cpti" Then str01 = ChrW("1591") & ChrW("1608") & ChrW("1576") & ChrW("1577") str02 = ChrW("1571") & ChrW("1605") & ChrW("1588") & ChrW("1610") & ChrW("1585") str03 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1607") & ChrW("1575") & ChrW("1578") str04 = ChrW("1576") & ChrW("1585") & ChrW("1605") & ChrW("1608") & ChrW("1583") & ChrW("1577") str05 = ChrW("1576") & ChrW("1588") & ChrW("1606") & ChrW("1587") str06 = ChrW("1576") & ChrW("1572") & ChrW("1608") & ChrW("1606") & ChrW("1577") str07 = ChrW("1571") & ChrW("1576") & ChrW("1610") & ChrW("1576") Str08 = ChrW("1605") & ChrW("1587") & ChrW("1585") & ChrW("1609") Str09 = ChrW("1578") & ChrW("1608") & ChrW("1578") Str10 = ChrW("1576") & ChrW("1575") & ChrW("1576") & ChrW("1577") Str11 = ChrW("1607") & ChrW("1575") & ChrW("1578") & ChrW("1608") & ChrW("1585") Str12 = ChrW("1603") & ChrW("1610") & ChrW("1575") & ChrW("1607") & ChrW("1603") ElseIf strLng = "Syr" Then str01 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") str02 = ChrW("1588") & ChrW("1576") & ChrW("1575") & ChrW("1591") str03 = ChrW("1570") & ChrW("1584") & ChrW("1575") & ChrW("1585") str04 = ChrW("1606") & ChrW("1610") & ChrW("1587") & ChrW("1575") & ChrW("1606") str05 = ChrW("1571") & ChrW("1610") & ChrW("1575") & ChrW("1585") str06 = ChrW("1581") & ChrW("1586") & ChrW("1610") & ChrW("1585") & ChrW("1575") & ChrW("1606") str07 = ChrW("1578") & ChrW("1605") & ChrW("1608") & ChrW("1586") Str08 = ChrW("1570") & ChrW("1576") Str09 = ChrW("1571") & ChrW("1610") & ChrW("1604") & ChrW("1608") & ChrW("1604") Str10 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") Str11 = ChrW("1578") & ChrW("1588") & ChrW("1585") & ChrW("1610") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1575") & ChrW("1606") & ChrW("1610") Str12 = ChrW("1603") & ChrW("1575") & ChrW("1606") & ChrW("1608") & ChrW("1606") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1571") & ChrW("1608") & ChrW("1604") End If MnthName = Choose(Format(dtAnyDate, "MM"), str01, str02, str03, str04, str05, str06, str07, Str08, Str09, Str10, Str11, Str12) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 5 DayName اسماء الايام - العربى - الانجليزى- اختصار الانجليزى ' .__ __. ___ .___ ___. _______ _______. ______ _______ _______ ___ ____ ____ _______. ' | \ | | / \ | \/ | | ____| / | / __ \ | ____| | \ / \ \ \ / / / | ' | \| | / ^ \ | \ / | | |__ | (----` | | | | | |__ | .--. | / ^ \ \ \/ / | (----` ' | . ` | / /_\ \ | |\/| | | __| \ \ | | | | | __| | | | | / /_\ \ \_ _/ \ \ ' | |\ | / _____ \ | | | | | |____ .----) | | `--' | | | | '--' | / _____ \ | | .----) | ' |__| \__| /__/ \__\ |__| |__| |_______||_______/ \______/ |__| |_______/ /__/ \__\ |__| |_______/ ' Public Function DayName(ByVal dtAnyDate As Date, ByVal strLng As String) 'to call the Function 'To Arabic Day Name 'txtDayNameAR =DayName(txtDate,"Ar") 'To English Day Name 'txtDayNameAR =DayName(txtDate,"En") 'To English Short Day Name 'txtDayNameEnòShrt =DayName(txtDate,"EnShrt") Dim strSat As String Dim strSun As String Dim strMon As String Dim strTues As String Dim strWed As String Dim strThurs As String Dim strFri As String If strLng = "Ar" Then strSat = ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1576") & ChrW("1578") strSun = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1581") & ChrW("1583") strMon = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1606") & ChrW("1610") & ChrW("1606") strTues = ChrW("1575") & ChrW("1604") & ChrW("1579") & ChrW("1604") & ChrW("1575") & ChrW("1579") & ChrW("1575") & ChrW("1569") strWed = ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1585") & ChrW("1576") & ChrW("1593") & ChrW("1575") & ChrW("1569") strThurs = ChrW("1575") & ChrW("1604") & ChrW("1582") & ChrW("1605") & ChrW("1610") & ChrW("1587") strFri = ChrW("1575") & ChrW("1604") & ChrW("1580") & ChrW("1605") & ChrW("1593") & ChrW("1577") ElseIf strLng = "En" Then strSat = "Saturday" strSun = "Sunday" strMon = "Monday" strTues = "Tuesday" strWed = "Wednesday" strThurs = "Thursday" strFri = "Friday" ElseIf strLng = "EnShrt" Then strSat = "Sat" strSun = "Sun" strMon = "Mon" strTues = "Tue" strWed = "Wed" strThurs = "Thurs" strFri = "Fri" End If DayName = Choose(Weekday(dtAnyDate), strSun, strMon, strTues, strWed, strThurs, strFri, strSat) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 6 عدد ايام الشهر ' .__ __. __ __ .___ ___. .______ _______ .______ ______ _______ _______ ___ ____ ____ _______. ' | \ | | | | | | | \/ | | _ \ | ____|| _ \ / __ \ | ____| | \ / \ \ \ / / / | ' | \| | | | | | | \ / | | |_) | | |__ | |_) | | | | | | |__ | .--. | / ^ \ \ \/ / | (----` ' | . ` | | | | | | |\/| | | _ < | __| | / | | | | | __| | | | | / /_\ \ \_ _/ \ \ ' | |\ | | `--' | | | | | | |_) | | |____ | |\ \----. | `--' | | | | '--' | / _____ \ | | .----) | ' |__| \__| \______/ |__| |__| |______/ |_______|| _| `._____| \______/ |__| |_______/ /__/ \__\ |__| |_______/ ' ______ _______ _______. _______ __ _______ ______ .___________. _______ _______ .___ ___. ______ .__ __. .___________. __ __ ' / __ \ | ____| / || ____|| | | ____| / || || ____|| \ | \/ | / __ \ | \ | | | || | | | ' | | | | | |__ | (----`| |__ | | | |__ | ,----'`---| |----`| |__ | .--. | | \ / | | | | | | \| | `---| |----`| |__| | ' | | | | | __| \ \ | __| | | | __| | | | | | __| | | | | | |\/| | | | | | | . ` | | | | __ | ' | `--' | | | .----) | | |____ | `----.| |____ | `----. | | | |____ | '--' | | | | | | `--' | | |\ | | | | | | | ' \______/ |__| |_______/ |_______||_______||_______| \______| |__| |_______||_______/ |__| |__| \______/ |__| \__| |__| |__| |__| ' Public Function NumofDays(ByVal dtAnyDate As Date) NumofDays = Day(DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0)) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 7 تاريخ آخر يوم فى الشهر ' _______ ___ .___________. _______ ______ _______ __ ___ _______..___________. _______ ___ ____ ____ ' | \ / \ | || ____| / __ \ | ____| | | / \ / || | | \ / \ \ \ / / ' | .--. | / ^ \ `---| |----`| |__ | | | | | |__ | | / ^ \ | (----``---| |----` | .--. | / ^ \ \ \/ / ' | | | | / /_\ \ | | | __| | | | | | __| | | / /_\ \ \ \ | | | | | | / /_\ \ \_ _/ ' | '--' | / _____ \ | | | |____ | `--' | | | | `----. / _____ \ .----) | | | | '--' | / _____ \ | | ' |_______/ /__/ \__\ |__| |_______| \______/ |__| |_______|/__/ \__\ |_______/ |__| |_______/ /__/ \__\ |__| ' ______ _______ _______. _______ __ _______ ______ .___________. _______ _______ .___ ___. ______ .__ __. .___________. __ __ ' / __ \ | ____| / || ____|| | | ____| / || || ____|| \ | \/ | / __ \ | \ | | | || | | | ' | | | | | |__ | (----`| |__ | | | |__ | ,----'`---| |----`| |__ | .--. | | \ / | | | | | | \| | `---| |----`| |__| | ' | | | | | __| \ \ | __| | | | __| | | | | | __| | | | | | |\/| | | | | | | . ` | | | | __ | ' | `--' | | | .----) | | |____ | `----.| |____ | `----. | | | |____ | '--' | | | | | | `--' | | |\ | | | | | | | ' \______/ |__| |_______/ |_______||_______||_______| \______| |__| |_______||_______/ |__| |__| \______/ |__| \__| |__| |__| |__| ' Public Function LastDayInMonth(ByVal dtAnyDate As Date) As Date 'to call the Function 'txtLastDayInMonth =LastDayInMonth(txtDate) LastDayInMonth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 8 تاريخ اول يوم فى الشهر Public Function FstDayOfMth(ByVal dtAnyDate As Date) As Date On Error GoTo handleError FstDayOfMth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 1) GoTo handleSuccess Exit Function handleSuccess: GoTo cleanUp Exit Function handleError: If Err.Number = 94 Then 'createFolder = True Else MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description End If GoTo cleanUp cleanUp: Exit Function End Function الروتين رقم 9 تاريخ اول يوم فى الشهر التالى Public Function FstDayOfNextMnth(ByVal dtAnyDate As Date) As Date FstDayOfNextMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 1) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 10 تاريخ اول يوم فى الشهر السابق Public Function FstDayPrevMnth(ByVal dtAnyDate As Date) As Date FstDayPrevMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) - 1, 1) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 11 تاريخ آخر يوم فى الشهر Public Function LstDayMnth(ByVal dtAnyDate As Date) As Date LstDayMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 1, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 12 تاريخ آخر يوم فى الشهر التالى Public Function LstDayNextMnth(ByVal dtAnyDate As Date) As Date LstDayNextMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate) + 2, 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 13 تاريخ آخر يوم فى الشهر السابق Public Function LstDayPrevMnth(ByVal dtAnyDate As Date) As Date LstDayPrevMnth = DateSerial(Year(dtAnyDate), Month(dtAnyDate), 0) End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 14 ظهور لغة الوقت التى تريدها - عربى - انجلبزى Public Function TimeByLng(ByVal dtAnyDate As Variant, ByVal strLng As String) Dim strAM As String: strAM = ChrW("1589") & ChrW("1576") & ChrW("1575") & ChrW("1581") & ChrW("1575") & ChrW("1611") Dim strPM As String: strPM = ChrW("1605") & ChrW("1587") & ChrW("1575") & ChrW("1569") & ChrW("1611") If strLng = "Ar" Then TimeByLng = MyNo(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), "AM", strAM), "PM", strPM), "ar") ElseIf strLng = "En" Then TimeByLng = MyNo(Replace(Replace(Format(dtAnyDate, "hh:nn:ss AM/PM"), strAM, "AM"), strPM, "PM"), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 15 ظهور لغة الوقت التى تريدها - عربى - انجلبزى Public Function TimeLng(ByVal strLng As String) Dim strAM As String: strAM = ChrW("1589") & ChrW("1576") & ChrW("1575") & ChrW("1581") & ChrW("1575") & ChrW("1611") Dim strPM As String: strPM = ChrW("1605") & ChrW("1587") & ChrW("1575") & ChrW("1569") & ChrW("1611") If strLng = "Ar" Then TimeLng = MyNo(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), "AM", strAM), "PM", strPM), "ar") ElseIf strLng = "En" Then TimeLng = MyNo(Replace(Replace(Format(Now(), "hh:nn:ss AM/PM"), strAM, "AM"), strPM, "PM"), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- الروتين رقم 16 ظهور لغة التاريخ التى تريدها - عربى - انجلبزى Public Function DateByLng(ByVal dtAnyDate As Variant, ByVal strLng As String) If strLng = "Ar" Then DateByLng = MyNo(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & ChrW(1605), "ar") ElseIf strLng = "En" Then DateByLng = MyNo(Format(dtAnyDate, "dd\/mm\/yyyy") & Space(2) & ChrW(1605), "En") End If End Function '----------------------------End------------------------------------------------------------------------------------------- يتبع .... DateFunctions.zip

تفضل لك ما طلبت بهذه المعادلة =SUMPRODUCT(($C$2:$C$17=$E6)*(SUBTOTAL(103,OFFSET($C2,ROW($C$2:$C$17)-MIN(ROW($C$2:$C$17)),0)))) معادلة عد الخلايا المرئية فقط بشروط.xlsx

السلام عليكم يبدو اننى حضرت متأخرا وزيادة فى الخير بعد تجربتكم لاجابة استاذ @walid7799 انظر الى الموضوع الاتى فيه ضالتك ان شاء الله ( اضافة اكثر من صورة مع الترقيم ) بدون الاعتماد على اى دوال API المرفق يعمل على النواتان 32 , 64

السلام عليكم ورحمة اله تعالى وبركاته انا بصدد تحديث لاحد قواعد البيانات قمت بتصميمها منذ ما يقارب 6 سنوات وان شاء الله سوف يكون هذا اول تحديث لى عليها وبأمر الله تباعا سوف اضع بين اياديكم درر وخلاصة افكارى اولا : اعتذر فى الفترة المقبلة عن التقصير فى الرد على التساؤلات لضيق وقتى ثانيا : ان شاء الله اقوم بالبناء خطوة بعد خطوة ومشاركتكم لعملى ----------------- بسم الله الرحمن الرحيم على بركة الله اولا سوف يتم مراعاة ان تعمل قاعدة البيانات على كلا النواتان X32 , x64 قاعدة البيانات سوف تكون مقسمة لقاعدتان اماية وخلفية المشكلة الأولى : عدم اتصال الجهاز الكلينت بجهاز السرفر الذى يحوى قاعدة البيانات واحضار الوقت والتاريخ من جهاز السرفر سوف ابدأ بكود جلب الوقت والتاريخ من جهاز السيرفر لاستاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr ولكن مع بعض الاضافات التى سوف تندمج بها بعد ذلك مع كود عمل الاكسس والربط بجهاز السرفر اولا فى رأس الموديول يتم الاعلان عن متغير عام Public GetsrvDate As Date بعد ذلك نقوم بعمل الروتين الاتى Public Function srvDate() srvDate = Nz(GetsrvDate, Null) End Function الروتين السابق لكى نستطيع استخدامة فى زوايا التطبيق اينما نريد سوف نسند اليه القيمة التى يحملها المتغير العام الذى قمنا بتعريفه فى رأس الموديول الروتين الاتى جلب الوقت والتاريخ من جهاز السرفر لاستاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr 'call By >>---> Me.srvr_Date_Time = Make_File3(Me.srvr_Domain_Name) Public Function Make_File3(BE_Path As String) On Error GoTo err_Make_File3 Dim PauseTime, Start 'we need the path to have a slash at its end If Right(BE_Path, 1) <> "\" Then BE_Path = BE_Path & "\" End If BE_Path = BE_Path & "dummy.txt" 'make the dummy txt file Open BE_Path For Output As #1 Print #1, "No text required" Close #1 'pasue for a second, until file is recognized, for slow networks PauseTime = 1 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop 'get the date created Make_File3 = FileDateTime(BE_Path) 'clean up, delete the file Kill BE_Path Exit_Make_File3: Exit Function err_Make_File3: If Err.Number = 75 Then MsgBox "Access Denied" & vbCrLf & "You do not have permission to write to the folder" ElseIf Err.Number = 53 Then Make_File3 = FileDateTime(BE_Path) Kill BE_Path BE_Path = vbNullString Make_File3 = vbNullString Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If Resume Exit_Make_File3 End Function بعد ذلك روتين الاتصال بالسرفر من خلال الاكسس Public Function AccessToSrv(ByVal ServerShare As String, ByVal UserName As String, ByVal Password As String, ByRef OpenFrmSplash As String) On Error GoTo Proc_Err Dim FSO As Object Dim Directory As Object Dim Filename As Object Dim NetworkObject As Object Set NetworkObject = CreateObject("WScript.Network") Set FSO = CreateObject("Scripting.FileSystemObject") NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password Set Directory = FSO.GetFolder(ServerShare) For Each Filename In Directory.Files 'Debug.Print Filename.Name Next 'Shell "cmd.exe /c start """" """ & ServerShare & """" ', vbNormalFocus 'Shell "C:\WINDOWS\explorer.exe """ & ServerShare & "", vbNormalFocus AccessToSrv = Make_File3(ServerShare) GetsrvDate = AccessToSrv DoCmd.Close DoCmd.OpenForm OpenFrmSplash Set Filename = Nothing Set Directory = Nothing Set FSO = Nothing NetworkObject.RemoveNetworkDrive ServerShare, True, False Set NetworkObject = Nothing Proc_Exit: Exit Function Proc_Err: Resume Proc_Exit Resume End Function يتم وضع الكود الاتى لبدأ روتين الاتصال بالشبكة فى العمل مع مراعاة الاتى 1- التأكد من عمل مشاركة لمجلد على جهاز السرفر والذى بدوره سوف يحتوى على قاعدة بيانات الخلفية 2- التأكد من بيانات الاتصال لعمل اكسس على جهاز السرفر كود الاتصال يتم وضعه على زر امر كالاتى Call AccessToSrv(Me.txtShardFolderPathe, Me.txtUserName, Me.txtPassWord, "frmMain") حيث أن txtShardFolderPathe= مسار مجلد المشاركة كاملا مثل \\192.168.1.3\DBSharing txtUserName = اسم المستخدم لفتح جهاز السرفر txtPassWord= كلمة مرور الولوج لجهاز السرفر "frmMain" = اسم النموذج الذى نريد لقاعدة البيانات فتحة بعد الولوج للسيرفر من هلال النموذج المعد لذلك ولو اردنا التعامل مع التاريخ الذى تم جلبه من السرفر من خلال call srvDate اترككم مع الاستمتاع بالمرفق LoginServer.accdb

أختي الكريمة السلام عليكم ورحمة الله وبركاته تم الحل من قبل أخي علي فلا ضرورة لإرفاق الملف من قبلي

أحسنت أخي الكريم @Ali Mohamed Ali جز اكم الله خيراً على هذه المعادلة الرائعة وألفت نظر أختنا الكريمة إلى أن هذه المعادلة التي استخدمها الأستاذ علي هي معادلة صفيف تحتاج في النسخ 2016 وما قبل إلى الضغط على Alt+Shift+Enter أما عن التغيير على المعادلة لتشمل صفوف عديدة فهي تحتاج تغيير ما بعد النقطتين : مثل تغيير من $C$17 إلى $C$100 أو أكثر والله أعلم .... كتبت هذا الرد ريثما تتلقين إجابة من أخينا علي على سؤالكِ الكريم والسلام عليكم.

اين الموضوع

استاذي اعزك الله المشكلة دة كود اخفاء واجهة اكسيس ption Compare Database Option Explicit Global Const SW_HIDE = 0 Private Declare Function apiShowWindow Lib "user32" _ Alias "ShowWindow" (ByVal hwnd As Long, _ ByVal nCmdShow As Long) As Long Function fSetAccessWindow(nCmdShow As Long) Dim loX As Long Dim loForm As Form loX = apiShowWindow(hWndAccessApp, nCmdShow) End Function في الوحدة النمطة ------------- كود حدث فتح النموذج Private Sub Form_Open(Cancel As Integer) fSetAccessWindow (SW_HIDE) End Sub وهذا يقوم بعملة المشكلة انه بخفي الواجهة للاكسيس والنموذج وانا اريد ان يخفي النموذج ويفتح واجهة الاكسيس ولا اريد نموذج اخر شكرا لحضرتك

وعليكم السلام-يمكنك استخدام معادلة المصفوفة (Ctrl+Shift+Enter) =IFERROR(INDEX(LIST!$A$12:$A$230,SMALL(IF(MONTH(LIST!$G$12:$G$230)=MONTH($C$2),ROW(A$12:A$230)-ROW(A$12)+1),ROWS($A$6:A6))),"") 1قائمة.xlsx

تمام ببساطة -يمكنك استخدام هذه المعادلة للتسلسل للتخلص من هذه المشكلة .. وبالتالى كده تم اكتمال طلباتك =AGGREGATE(2,5,$A$1:A1)+1 ياسمين 2.xlsx

المعذرة مرة أخرى من إخوتي الكرام لكن أختنا الكريمة كان لابد للنتائج أن تكون على أساس يظهر كل المناطق بخلاف ما هو موجود في الصورة وستكون النتائج قاصرة على المناطق التي تم وضع المعادلات لها دون المنصورة والصحيح هو أن يكون جدول النتائج كما يلي:

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

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

بعد اذن حضراتكم اساتذتى الفضلاء عمل تعديل لهذا الملف لانه الملف الحقيقى الذى ساعمل عليه جزاكم الله خيرا جزاك الله خيرا استاذ محمد ورقة عمل Microsoft Excel جديد.xlsx

انا اسف 🤭 نسيت وضع الرابط كنت على عجلة للذهاب الى عملى تم تعديل الرد واضافة رابط الموضوع

عندما نحاول عمل اكسس على جهاز السرفر لاول مرة يكون من خلال هذه الشاشة وفى بعض الاحيان بعض الاجهزة لا تحتفظ بالبيانات ونضطر لكتابة بيانات الاتصال فى كل مرة قبل فتح قاعدة البيانات الفكرة فى المرفق هى الاحتفاظ ببيانات تسجيل الدخول للجهاز فى الجدول رقم الـ IP + اسم المجلد المخصص للمشاركة او اسم الجهاز + اسم المجلد المخصص للمشاركة لا يكفي ان تكتب رقم IP السرفر او اسم جهاز السرفر ، بينما يجب ان تكتب اسم المجلد الذي لك فيه صلاحية الكتابة Read/Write وطبعا لاننا سوف نقوم باستخدام مجلد المشاركة الذى يحتوى قاعدة بيانات الخلفية اذا المجلد لابدان تكون فيه صلاحية الكتابة Read/Write اسم المستخدم لعمل الاتصال كلمة المرور الخاصة بالاتصال وتم عمل تصوير للشاشة من واقع العمل على المرفق

نزلت الاثنين .. بس الثلاثاء ما يشتغل !! 😅✋🏻 أمزح .. وما اشتغلوا باثنيتهم .

اذا ممكن تعدلي الملف بالحالات المطلوبة لتثبيت المعادلات عليه

بارك الله وشكراً لك

أشكرك أخ محمد وجزاك الله كل خير هذا هو المطلوب لك جزيل الشكر

اليوم طريقة بحث بشكل عبقرى يبحث عنه الكثير من المبتدئين أمثالى عايز أبحث فى كل الحقول ولكن بشروط معينة (كلمة أو حرف من كل حقل ويكون البحث مرتبط ويكون فى نموذج واحد) أزاااااى ى ى ى ى ى !!! 1- أولاً نعمل نموذج به قوائم منسدلة بعدد الحقول فى الجدول أو أكثر من جدول والتى يمكن البحث فيها أياً كانت (أرقام - تواريخ - حروف ... الخ) 2- نعمل استعلام يضم كل الحقول بأى جدول نريد أن ينضم إلى البحث (حتى لو ألفين حقل) ولا يهمك .. عك وربك يفك 3- نضع فى المعايير (Criteria) وعلى سطر واحد تحت كل حقل كالتالى بالترتيب [forms] ! [أسم فورم البحث] ! [أسم مكان البحث سواء كومبوبوكس أو تكست بوكس] ونكتب OR ثم نأخذ ما تم كتابته قبل كلمة OR نسخ وبعد كلمة OR نقوم اللصق حتى تصبخ الجملة قبل كلمة OR نفس الجملة بعدها ونأخذ مسافة ونكتب Is Null وبين Is وبين Null مسافة وتكرر العملية لكل حقل ملحوظة هامة:- بالنسبة للحقول النصية نفس الطريقة ... ولكن نضع قبل الجملة الأولى Like مسافة "*" مسافة & وذلك قبل كلمة OR لتصبح النتيجة كالتالى بالنسبة للأرقام وبالنسبة للحقول النصية تصبخ النتيجة كالتالى : ونضع كل ما سبق فى نموذج يكون مصدر سجلاته هدا الاستعلام ويكون نموذج فرعى ويكون النموذج الأول اللى فيه خانات البحث ... أوعى يكون حد نسيه النموذج أللى جبنه منه خانات البحث فى الاستعلام ... أيوه ه ه ه ه (هو دة) وضبع به نموذج الاستعلام ونعمل كويرى كل حاجة لكل حاجة بمعنى أن كل خانة بنكتب فيها تعمل كويرى لكل خانات البحث الأخرى ونضع زر بحث يقوم بعمل كويرى للصب الفورم الذى تظهر به نتائج البحث ... وأخيراً ... شكل نمودج البحث والسلام عليكم ورحمة الله وبركاته برجاء لا تنسونا بالدعاء ولمن علمنا والفضل كله لله

تفضل الدائن و المدين-5.rar

السلام عليكم ...إليك الحل أخي الكريم =CONCATENATE(TEXT(A2;"yyy/mm/dd");" ";TEXT(B2;"hh:mm am/pm")) New XLS Worksheet.xls

جميعكم خبراء في نظري .. وجميعنا نتبادل خبراتنا ونكمل بعضنا .. 🌷 كل الحب والمودة لكم 🙂🌹

وضح ... ماهي النتائج الغير صحيحة ولا تترك الموضوع عائم ... حتى نجد حل بامرالله ... ما هي النتائج الظاهرة لديك .. صورة لها ... وصورة للصحيح ...

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