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

السلام عليكم ورحمة الله تعالى وبركاته اجندة مواعيد الكترونية حتى يأخذ كل ذى حق حقه المرفق مثال أجنبى تم التعديل عليه وتم استخدام افكار وأكواد من المنتدى تخص الاستاذ @أبو آدم جزاه الله خيرا وتم اضافة بعد التعديلات من العبد الفقير الى الله والتى كانت تناسبنى وقت التعديل على المرفق وتم اضافة وتطوير المرور بين الاشهر والسنوات ملاحظة هامة : تم تحديث التكويد الخاص بدوال الـ API ليدعم العمل على النواتان 32x , 64x ولكن لن استطيع التجربة فى الوقت الحالى للنواة 32x برجاء من يقوم بتجربة المرفق يذكر أصدار نواة الأوفيس الخاص بجهازه وبالأخص من يملك النواة 32x Outlook Style Calendar.mdb

السلام عليكم اساتذتنا الافاضل قديما اذكر عندما كنا نستخدم اكسس 2003 كان هناك خيار ضمن ادوات اكتف اكس بحيث نستطيع ادراج رزنامة الى نموذج اكسس الان استخدم اكسس 2019 مفعلة مدى الحياة ومحتاج جدا لادارج الرزنامة في احد برامجي الغريب انني لم اجدها ضمن قائمة اكتف اكس هل هناك حل لهذا الموضوع ؟؟ الله يجزيكم الخير

Calendar.mdb

ادراج رزنامة شهرية لسنة معينة و شهر معين (باختيارك) بدون يوم او يومين تحددهما بنفسك و اذا لم تحدد الايام (بمسح الخلايا المناسبة) يتم ادراج كامل الشهر Sub Give_date_without_same_days() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With If Not IsNumeric([a2]) Or Not IsNumeric([b2]) _ Or [b2] < 1 Or [b2] > 12 _ Or IsEmpty([a2]) Or IsEmpty([b2]) Then MsgBox "أدخل أرقاماً صحيحة في الخلايا " & Chr(10) & "$ِِِA$2 and $B$2 " & Chr(10) _ & "وأعد المحاولة", vbOKOnly + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "!...ٍSalim" Range("c4:Ag5").ClearContents Range("c4:Ag5").Borders.LineStyle = 0 GoTo Exit_Me End If With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlManual End With Dim Array_Days(), My_Days_Arabic() Dim Arab_Day(), My_Date_For_Print() Dim Array_Numbers() Dim t As Date, i%, k%, m%, x%, last_col% Dim y$ '============================== Array_Days = Array("sun", "mon", "tue", "wed", "thu", "fri", "sat") Arab_Day = Array("الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس", "الجمعة", "السّبت") Array_Numbers = Array(1, 2, 3, 4, 5, 6, 7) last_col = Cells(5, Columns.Count).End(1).Column Range("c4").Resize(2, last_col).ClearContents Range("c4").Resize(2, last_col).Borders.LineStyle = 0 '================================= [a2] = Int([a2]): [b2] = Int([b2]) t = DateSerial([a2], [b2], 1) x = Day(Application.EoMonth(t, 0)) k = 1 For i = 1 To x y = Application.Index(Arab_Day, Application.Match(Weekday(t), Array_Numbers, 0)) If Trim(y) = Trim([d2].Value) Or _ Trim(y) = Trim([e2].Value) Then GoTo 2 ReDim Preserve My_Days_Arabic(1 To k): My_Days_Arabic(k) = y ReDim Preserve My_Date_For_Print(1 To k): My_Date_For_Print(k) = t k = k + 1 ' End If 2: t = t + 1 Next Range("C4").Resize(1, UBound(My_Days_Arabic)) = My_Days_Arabic Range("C5").Resize(1, UBound(My_Date_For_Print)) = My_Date_For_Print Range("C4").Resize(2, UBound(My_Days_Arabic)).Borders.LineStyle = 1 ActiveSheet.PageSetup.PrintArea = "" ActiveSheet.PageSetup.PrintArea = Range("a1").Resize(6, UBound(My_Days_Arabic) + 2).Address Exit_Me: Erase Array_Days: Erase Arab_Day: Erase Array_Numbers With Application .ScreenUpdating = True .Calculation = xlAutomatic .EnableEvents = True End With End Sub Private Sub CommandButton1_Click() Give_date_without_same_days End Sub Private Sub Worksheet_Activate() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With End Sub الكود موجود ضمن الملف Date_sans_deux_jours.xlsm

مطلوب ظهور calendar عند الوقوف على خلية معينة لاختيار التاريخ مع الشرح لو سمحتم وشكرا

إخوتي الفضلاء أقدم من مكتبتي تطبيق التقويم لتثبييت المواعيد والأحداث ، وقد إستخدمت الفكرة و أجزاء من التطبيق في كثير من التطبيقات الخاصة وهو منظومة للتقويم ولتثبيت المواعيد و الأحداث ، ويمكن إظهار التقويم كنموذج لليوم و / أو الأسبوع و / أو شهر ويحاكي التصميم المستخدم في MS OUTLOOK آملاً عموم الفائدة والله من وراء القصد وهو حسبي ............ NA_Calendar.rar