البحث في الموقع

تقومان بفحص تقويم الـ vba ونوع المدخل، فهي تساعد المستخدم كثيرا وتجنبه الأخطاء إن شاء الله. عملت تجاربي عليها، ويمكنكم اجراء المزيد من التجارب. Option Compare Database Option Explicit Function Greg2Hijri(GregDate As Variant, _ Optional dFormat As String = "yyyy/mm/dd") As Variant Dim CurCal As VbCalendar On Error Resume Next CurCal = Calendar Greg2Hijri = Null '"WrongInput" If Calendar = vbCalGreg And (VarType(GregDate) = vbDate Or _ VarType(GregDate) = vbLong) Then Calendar = vbCalHijri Greg2Hijri = Format(GregDate, dFormat) ElseIf VarType(GregDate) = vbString Then Calendar = vbCalGreg If IsDate(GregDate) Then Greg2Hijri = CDate(GregDate) End If End If Calendar = CurCal End Function '------------------------- Function Hijri2Greg(HijriDate As Variant, _ Optional dFormat As String = "yyyy/mm/dd") As Variant Dim CurCal As VbCalendar On Error Resume Next CurCal = Calendar Hijri2Greg = Null '"WrongInput" If Calendar = vbCalHijri And (VarType(HijriDate) = vbDate Or _ VarType(HijriDate) = vbLong) Then Calendar = vbCalGreg Hijri2Greg = Format(HijriDate, dFormat) ElseIf VarType(HijriDate) = vbString Then Calendar = vbCalHijri If IsDate(HijriDate) Then Hijri2Greg = CDate(HijriDate) End If End If Calendar = CurCal End Function '-------------------------------------------------------------------- Sub TestingDateConverting() Dim CurCal As VbCalendar CurCal = Calendar Debug.Print "Greg2Hijri" Calendar = vbCalGreg Debug.Print Greg2Hijri(Date, "yyyy-mmmm-dd") Debug.Print Greg2Hijri(CLng(Date), "yyyy mm dd") Debug.Print Greg2Hijri("06/07/2023") Debug.Print "-----------" Calendar = vbCalHijri Debug.Print Greg2Hijri(Date, "yyyy-mmmm-dd") Debug.Print Greg2Hijri(CLng(Date), "yyyy mm dd") Debug.Print Greg2Hijri("06/07/2023") Debug.Print "-------------------------------" Debug.Print "Hijri2Greg" Calendar = vbCalHijri Debug.Print Hijri2Greg(Date, "yyyy-mmmm-dd") Debug.Print Hijri2Greg(CLng(Date), "yyyy mm dd") Debug.Print Hijri2Greg("18/12/1444") Debug.Print "-----------" Calendar = vbCalGreg Debug.Print Hijri2Greg(Date, "yyyy-mmmm-dd") Debug.Print Hijri2Greg(CLng(Date), "yyyy mm dd") Debug.Print Hijri2Greg("18/12/1444") Debug.Print "-------------------------------" Calendar = CurCal End Sub

السلام عليكم ورحمة الله تعالى وبركاته تحية طيبة عطرة موديول واحد قمت بتجميع الدوال الهامة للتاريخ بحيث يسهل استخدامها مع الاخذ فى الاعتبار بمرونة التحكم الشامل فى كل كبيرة وصغيره بسم الله الرحمن الرحيم وعلى بركة الله طالما سوف نتطرق الى التاريخ والتعامل معه لابد أن نبدأ على خطى استاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @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

ادخال التاريخ الهجري بصورة مباشرةيطلب الكثير من الأصدقاء طريقة لإدخال التاريخ الهجري بصورة مباشرة ثم تحويله الى التاريخ الميلاديهنا سأشرح كيفية ادخال التاريخ الهجري بصورة مباشرة لإمكانية تحويله فيما بعد الى التاريخ الميلادي بدون أي كود أو معادلات معقدةيجب ان نعرف أولا ان الاكسيل يستعمل يوم 1/1/1900 للميلاد كبداية لإدخال التاريخ وجميع الحسابات المتعلقة بالتاريخ تبدأ من هذا التاريخ، وأي ادخال لتاريخ قبل 1/1/1900 يعتبره الاكسيل "نص" "TEXT" ولا يجري عليه أيه حسابات.لإدخال التاريخ الهجري في خلية يجب ان نقوم بعمل تنسيق أرقام لتلك الخلية قبل ادخال التاريخ حسب الخطوات التالية: 1- نختار تنسيق خلايا "Format Cells" 2- من "Number" نختار "Date" 3- من "Calendar Type" نختار "Arabic Hijri" 4- نؤشر على مربع "Input dates according to selected calendar" 5- ننقر على مفتاح OK والان الخلية جاهزة لإدخال التاريخ الهجري بصورة مباشرة واجراء كافة عمليات التاريخ كما لو كانت بالتاريخ الميلادي ملاحظة مهمة: أصغر تاريخ بالهجري يقبله الاكسيل هو 29/8/1317 ويقابل 1/1/1900 الملف المرفق فيه التوضيح وجاهز الى العمل تحويل التاريخ الهجري الى ميلادي والعكس.rar

https://www.youtube.com/watch?v=cwIX7kTV7HQ

السلام عليكم ورحمة الله وبركاته شغال على ملف اكسل خاص بجلسات متقسم لشيت فهرس عام وشيتات بعدد شهور السنة محتاج ارحل البيانات من الفهرس العام ده للشهور بتاعتها بحيث كل جلسة تتنقل للشهر بتاعها حسب التاريخ الموجود في خانة تاريخ الجلسة الملف مرفق وشكرا ليكم مقدماً فهرس مجمع.rar

السلام عيكم ورحمة الله وبركاته لو سمحته عندي استفسار كيف ممكن اعمل استعلام بحقل تاريخ الميلاد بحيث يقارن بتاريخ الكمبيوتر ويحسب فارق معين مثلا اقل من 18 سنة و جزاكم الله خير

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

بسم الله و ما شاء الله اللَّهُمَّ انْفَعْنَا بِمَا عَلَّمْتَنَا , وَعَلِّمْنَا مَا يَنْفَعُنَا , وَزِدْنَا عِلْمًا إِلَى عِلْمِنَا اهداء لكل من شارك بعلمه اقل ما يقال لكم "عندما تنتهى كلمات الابداع و تبدأ من جديد و تنتهى عندكم" بارك الله لكم ( فكرة المدونة هى سهولة الوصول و البحث فى المنتدى للذهاب الى ملف _ المدونه الاصدار الاول من هنا مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_سلسله تجميعيه (مميز ) دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي _ أ / عبدالله باقشير دالة لاستخراج اسم واحد او عدة اسماء من اسم كامل _ أ / عبدالله باقشير دالة استخراج اسم ولي الامر كاملا او الاسم الاول مفردا _ أ / عبدالله باقشير دالة جديدة لاستخراج ولي الامر _ أ / عبدالله باقشير دالة استخراج النص او الارقام _ أ / عبدالله باقشير برنامج حساب العمر بالتقويمين الميلادي والهجري (برنامج جاهز) _ أ / عبدالله باقشير دالة ( تفقيط ) تحويل الرقم الى نص بالعربي - طول الرقم غير محدود - _ أ / عبدالله باقشير التعامل مع التاريخ الهجري بسهولة _ أ / عبدالله باقشير بالكود و المعادلات_تحويل التاريخ من هجرى الى ميلادى و العكس _ أ / عبدالله باقشير دمج التاريخ مع السلاسل النصية_التاريخ بالكمبوكس _ أ / عبدالله باقشير _ أ / أبوعبد الله_اكسلجى كود صغير جدا و لكن مفيد جدا_ادراج تاريخ تلقائى بالخلية بناء على ادخال بيان _ أ / عبدالله باقشير كود صغير جدا و لكن مفيد جدا_التحديث التلقائى للوقت و التاريخ _ أ / عبدالله باقشير لتقف كل الأكواد عاجزة أمام دالة " فصـــــــــــل الأسماء المركبة "_ _ أ / جمال عبد السميع كود فصل الأسم المركب " وحل جميع مشاكلة للأبد " _ أ / جمال عبد السميع بمناسبة العام الدراسى ( أحسب سن تلاميذك ) بالميلاد أو القومى_ _ أ / جمال عبد السميع ستوب ووتش_كود و برنامج _ الاستاذ / الحسامي رحمه الله _ أ / محمد يحياوي أربعة عشر طريقة لمعرفة السنة الكبيسة أو السنة العادية باستخدام المعادلات _ أ / ياسر خليل أبو البراء التقويم بعد التعديل (برنامج جاهز) _ أ / منتصر الانسي اشهر المعادلات والاكواد عن حساب السن _ أ / جمال الفار دالة جديدة لاستخراج اسم المحافظة وتاريخ الميلاد والنوع من الرقم القومي المصري _ أ / عبدالله المجرب كود جميل و بسيط لاضافة التاريخ _ أ / احمد فضيله داله DateDif رائعه لايجاد الفرق بين تاريخين او طرح تاريخين _ أ / الصـقر ايجاد الفرق بين تاريخين بواسطة الدوال التالية (YEAR,MONTH.DAY) _ أ / الجموعي الفرق بين تاريخين باستخدام الدالة DATEDIF _ أ / محمد الريفى دالة تجزئة الاسماء والارقام _ أ / أبو تامر_عمر الحسينى تفقيط عربي انجليزي _ أ / أبو تامر_عمر الحسينى فصل وفرز الأرقام التي تمثل التاريخ والوقت _ أ / halwim برنامج رائع للتحويل بين التاريخين الهجري والميلادي (برنامج جاهز) _ أ / علي السحيب برنامج جديد لحساب العمر (برنامج جاهز) _ أ / علي السحيب برنامج حساب السن لرياض الاطفال -اولى ابتدائي _ أ / ابوصلاح تقويم متجدد _ مع تظليل اليوم مشاركات / BuFaisal _ أبوعبد الله إنشاء مؤقت داخل مصنف اكسيل_ستوب ووتش _ أ / زياد علي إستخراج البيانات من الرقم القومي المصري ( أكواد و معادلات ) _ أ / معتصم محمد برنامج بسيط لحساب السن وصلاحية المواد _ أ / ياسر الحافظ 2012 ملف التفقيط الارقام الى حروف فى الاكسيل بدون ماكرو convert numbers into text مشاركه من أ / Hrashad وأخييييراً صممت ساعة ديجيتال _ أ / الزباري ساعة رقمية _ أ / عادل حنفي تحويل التاريخ بين الميلادى و الهجرى_حالات متعددة _ أ / أبوعبد الله_اكسلجى تحويل التاريخ الميلادي لهجري بمعادلة وصيغ تاريخ مختلفة _ أ / أبوعبد الله_اكسلجى كود و دالة تفقيط للارقام و الاوزان_حالات متعدده _ أ / أبوعبد الله_اكسلجى بالمعادلات_تحويل الساعات إلى ساعات ودقائق و ثواني _ أ / أبوعبد الله_اكسلجى بالفورم_حساب الفرق بين وقتين _ أ / أبوعبد الله_اكسلجى _ أ / ابو اسامة العينبوسي ساعه ستوب واتش (برنامج جاهز) _ أ / ابو اسامة العينبوسي التفقيط فى الإكسيل _ أ / محمد طاهر وأخيراُ - عمل دالة التفقيط بسهولة شديدة وبالتفصيل الممل _ بدأه _ أ / بكار للأبد تقويم 2017 _ أ / جلال محمد اظهار التاريخ في ورقة العمل الاكسل بدون كتابة التاريخ _ أ / abumaher هدية للمبتدئين.... حساب العمر _ أ / حساسينو بالكود و المعادلات _ تحويل المبلغ إلى حروف _ مشاركات الاعضاء كود ادراج الوقت بدبل كليك فى خليه او نطاق _ مشاركات الاعضاء بالكود عمل سلسلة من التواريخ مع استبعاد ايام الجمعه و السبت(الاجازات) _ مشاركات الاعضاء بالكود و المعادلات_الفصل بين النص والأرقام _ مشاركات الاعضاء موضوع مميز_بالكود و المعادلات حساب العمر _ مشاركات الاعضاء موضوع مميز_تنسيق خاص للوقت _ مشاركات الاعضاء تثبيت التاريخ والوقت الحالى فى خليه دون جعله يتغير دائما _ مشاركات الاعضاء ادراج التاريخ في الخلية من خلال ظهور شاشة تقويم _ مشاركات الاعضاء

مطلوب المساعدة اريد اضافة اداة لاختيار التاريخ مباشرة على الفورم بدل من كتابته يدويا *** مثل اداة التيكست بوكس والكومبوبوكس (( هنا اريد اداة اختيار التاريخ ؟ )) جزيل الشكر

مساء الخير كيف استطيع معالجة التاريخ الذي يظهر كنص .. احتاج الى كود يعالج هذه المشكلة التي دائما ما تواجهني عند استيراد ملف من النظام المحاسبي. الغريب ان بعض التواريخ الظاهرة في الجدول صحيحة وبعضها غير صحيحة .. يمكن ملاحظة ذلك عند تصفية العمود. اتمنى اجد حل مناسب ( كود أو معادلة ) وشكرا لكم.. Bill_date.rar

السلام عليكم ورحمة الله وبركاته , إخواني الأحبة , هل يمكن أن أكتب في الخلية التاريخ الميلادي والإكسل تلقائيا يكتب التاريخ الهجري في نفس الخلية ؟ ولا لازم أعمل خلية أخرى للتاريخ الهجري ؟ إذا ممكن فكيف الطريقة ؟ بارك الله فيكم .

السلام عليكم في هذا المصنف المرفق كود عند الكتابة في العمود B يظهر التاريخ في العمود A ولكن الذي اريدة هو الكتابه في العمود C ويظهر التاريخ في العمود A وشكرا التاريخ.rar

اريد طريقه لتحويل التاريخ الى رقم كما في المرفقات ورقة عمل Microsoft Excel جديد.rar

السلام عليكم ورحمة الله وبركاته أسعد الله أوقاتكم .. لدي التاريخ الميلادي بالصيغة التالية 22/05/2016 واريد تحويله إلى الهجري بنفس الصيغة 15/08/1437 أرجو من حضراتكم التفضل بتزويدي بكود التحويل لملف اكسيل 2010 وأشكركم مقدما أزادكم الله من علمه ومن فضله ..

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

بمجرد ان اضع التاريخ في A2 يسجل تلقائي 7 ايام على التوالي وان يكون يوم الجمعة والسبت بلون مخالف كما موضح تاريخ.rar

عفوا. شهرا مبارك: معادلة أريد بها مجرد الكتابة في خلية يضهر التاريخ في خلية أخرى تاريخ اليوم لكن لا أريد أن يتغير التاريخ يعني يضل ثابت حتى لو تغير التاريخ الجهاز والملف مرفق ييي.rar

مرفق ملف إكسل إذا فتحته ستعرف الوقت واليوم والتاريخ الآن بالتقويم الميلادي وأيضا بالتقويم الهجري، ولا يوجد عليه حماية لمن أراد أن يستفيد. وهو هدية مجانية للجميع مقابل دعواتكم.

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

بسم الله الرحمن الرحيم اخواني .. أعزائي الكرام اشكركم جميعاً على هذا المنتدى الرائع وأشكر كل الأعضاء الذين أثروا هذا المنتدى بالموضوعات التي ساعدتنا على تطوير قدراتنا في التعامل مع الأكسل ولدي سؤال أو مشكلة لدي عمود اكتب فيه التاريخ فإن كان التاريخ يوافق يوم عطلة رسمية تظهر ملاحظة نصية في العمود المجاور طبعا لا أواجه مشكلة بانسبة للمناسبات المرتبطة بالتقويم الميلادي مثل عيد العمال مثلاً لأنه دائما يصادف اول مايو من كل عام لكن اواجه مشكلة بالنسبة بالعطلات المرتبطة بالتقويم الهجري فإنه غير منضبط بالنسبة للتقويم الميلادي.. فهل من حل بارك الله في الجميع