AbuuAhmed

يبدو أني فهمت المطلوب بشكل خاطئ بعد أن اجتهدت في حل لفهمي الخاطئ وجدت أن المطلوب على خلاف فهمي 🙂 . دائرة حول الرقم_02.xlsm

سؤالي للمشاركين في الموضوع ولقرائه: ما الخطأ في حلي ما يجعل هذا السائل برفضه ويستنكف الاعتراف بصوابه؟! مرفق صورة لنفس لنتائج حلي السابق وبنتائج أكثر صحة من نتائجه، شاهدوا سجل محمد عيسى لشهر يوليو أيهما أصح عنده أم عندي؟ كذلك أعتقد عنده خطأ آخر لتاريخ نهاية شهر أغسطس فهو 31 يوم وليس 30 يوم. ردوا على مثل هذا السائل ولا تكونوا سببا في تطفيش الخبراء من الموقع.

أعتقد الحل رياضياتيا صحيح، فقط المشكلة أني لم احترز لوجود خلايا فاضية بناء على المثال في المرفق السابق. لاحظ أجوبتك (مبهمة) غير صريحة!! يجب تحديد الخطأ بشكل واضح. محاولة أخرى بدون تغيير في النتائج فقط تم تبديل نوع المتغيرات احترازا عند وجود خلايا فاضية في العطل/الإجازات. Function Between(inDate As Long, Date1 As Long, Date2 As Long) As Boolean Between = inDate >= Date1 And inDate <= Date2 End Function Function getHolidays(Holiday1 As Long, Holiday2 As Long, _ Workday1 As Long, Workday2 As Long) As Integer Dim Date1 As Long, Date2 As Long 'On Error Resume Next 'Min date is 31/12/1899 If Holiday1 <= 0 Or Holiday2 <= 0 Then Exit Function If Between(Holiday1, Workday1, Workday2) Or _ Between(Holiday2, Workday1, Workday2) Or _ Between(Workday1, Holiday1, Holiday2) Or _ Between(Workday2, Holiday1, Holiday2) Then Date1 = IIf(Holiday1 >= Workday1, Holiday1, Workday1) Date2 = IIf(Holiday2 <= Workday2, Holiday2, Workday2) getHolidays = Date2 - Date1 + 1 End If End Function حساب أيام العمل خلال_04.xlsm

حياك الله أخي، جوابك غير واضح، إذا لا زلت تنتظر حلول أخرى فاطلبه بشكل مباشر ليستمر الأعضاء في المحاولات. أما إذا وجدت الحل فحدده ليكن كذلك واضحا للجميع.

الصراحة معظم دوال الإكسل المستجدة أجهلها، فعملت لك دالة بالـ vba عملتها وأنا شبعان وأفكر في القيلولة، فربما تحتوي على أخطاء. Function Between(inDate As Date, Date1 As Date, Date2 As Date) As Boolean Between = inDate >= Date1 And inDate <= Date2 End Function Function getHolidays(Holiday1 As Date, Holiday2 As Date, Workday1 As Date, Workday2 As Date) As Integer Dim Date1 As Date, Date2 As Date If Between(Holiday1, Workday1, Workday2) Or _ Between(Holiday2, Workday1, Workday2) Or _ Between(Workday1, Holiday1, Holiday2) Or _ Between(Workday2, Holiday1, Holiday2) Then Date1 = IIf(Holiday1 >= Workday1, Holiday1, Workday1) Date2 = IIf(Holiday2 <= Workday2, Holiday2, Workday2) getHolidays = Date2 - Date1 + 1 End If End Function حساب أيام العمل خلال_03.xlsm

تنقيح أخير، أصبح فيه الكود سطر واحد فقط 🙂 Sub Date2Text() Range("B7", "AJ23").NumberFormat = "m-d" End Sub

تم تنقيح الكود سابقا لو ضغطت الزر أكثر من مرة فسوف يبدل النتائج مع كل ضغطة أما الآن سيبدلها مع الضغطة الأولى فقط. Sub Date2Text() Const sRow = 7, eRow = 23 Const sCol = 2, eCol = 36 Dim Row As Integer, Col As Integer Application.EnableEvents = False Application.ScreenUpdating = False For Row = sRow To eRow For Col = sCol To eCol With Cells(Row, Col) If .NumberFormat = "d-mmm" Then .NumberFormat = "@" If .Value <> "" Then .Value = Month(.Value) & "-" & Day(.Value) End If Else .NumberFormat = "@" End If End With Next Col Next Row Application.EnableEvents = True Application.ScreenUpdating = True MsgBox "Done" End Sub

بالأكواد من زر asc2Text_02.xlsm

تذكرت موضوع قديم، قد يسهم في إثراء الموضوع:

...

جرب هذا الخيار في قبل الطباعة: Page Setup -> Sheet -> Black and white

جرب احذف الأقواس

جمعت الحلين في مثال واحد واضطررت لحذف كل الأكواد المتعلقة بحل الأستاذ عسل قليل الدسم مع الاعتذار لمزيد من التركيز للسائلة. تجربة صادر_05.accdb

يمكن حلها كذلك بالأكواد إذا أردتها تظهر بتنسيق كما الوقت مع أن تنسيق الوقت لا يقبل أكثر من 24 ساعة. تقرير التأخير الشهري_03.xlsx

حل آخر تجربة صادر_04.accdb

للتجربة .. الحل هو المظلل بالأصفر إن شاء الله. تجربة صادر_03.accdb

موضوع شيق، ربما المشكلة ليست في الدوال، وتخميني أنك تحتاجين عمل Requery للنموذج الفرعي و ربما للرئيسي بعد كل عملية إضافة. أنا من فترة بعيد عن الأكسس، لو ترفعين مثال ستسهل عملية التجارب والمحاولات. الموضوع ليس بالصعب إن شاء الله. هل الحقل رقمي أم نصي؟ وإذا كان نصي هل لنا أن نعرف تنسيقه؟

حل آخر بالأكواد، في الموضوع السابق فهمتك خطأ بأنك تريد أن يبدأ الشهر دائما مع يوم الأحد وقد تم التعديل في هذه النسخة يتم مراجعة خلية العام الدراسي في حال لم يتم تعديله من قبلكم. حساب_التاريخ_09.xlsm

تم تنقيح الكود لتسهيل التعديل عليه Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, DateRange As String, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target DateRange = Replace(.Address, "$", "") If DateRange <> "M1" Then 'تبديل عنوان خلية التاريخ عند الحاجة' Beep 'MsgBox Exit Sub End If If Not IsDate(Range(DateRange)) Then Beep 'MsgBox Exit Sub End If Application.EnableEvents = False Application.ScreenUpdating = False yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_06.xlsm

حل آخر بالكود: Private Sub Worksheet_Change(ByVal Target As Range) Dim Row As Integer, Col As Integer Dim fRow As Integer, fCol As Integer, fdd As Integer Dim yy As Integer, mm As Integer, dd As Integer Dim cellDate As Date, m m = Array("", "يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", _ "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") With Target If Not (Target.Row = 1 And Target.Column = 13) Then Exit Sub yy = Year(.Value) mm = Month(.Value) For fdd = 1 To 7 If Weekday(DateSerial(yy, mm, fdd)) = vbSunday Then Exit For Next fdd End With Cells.Find(What:="الأحد", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Activate fRow = ActiveCell.Row fCol = ActiveCell.Column + 1 Application.EnableEvents = False Application.ScreenUpdating = False Cells(fRow - 2, fCol + 5) = m(mm) dd = fdd - 3 For Col = fCol To fCol + 9 Step 2 dd = dd + 2 For Row = fRow To fRow + 4 dd = dd + 1 cellDate = DateSerial(yy, mm, dd) If Month(cellDate) = mm Then Cells(Row, Col + 0) = cellDate Cells(Row, Col + 1) = 1 Else Cells(Row, Col + 0) = "" Cells(Row, Col + 1) = "" End If Next Row Next Col Application.EnableEvents = True Application.ScreenUpdating = True End Sub حساب_التاريخ_05.xlsm

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

كما فهمت: Private Sub أمر0_Click() Dim msgRes As VbMsgBoxResult Const msg = "ماذا تريد ان تفعل Yes فتح نموذج NO فتح تقرير Cancel تراجع " msgRes = MsgBox(msg & vbCrLf & "" & vbCrLf & "الحمدلله", vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "الله المستعان") '--- طريقة أولى ---- If msgRes = vbYes Then DoCmd.OpenForm "22" ElseIf msgRes = vbNo Then DoCmd.OpenReport "33", acViewPreview ElseIf msgRes = vbCancel Then Exit Sub End If '--- طريقة أخرى ---- 'Select Case msgRes ' Case vbYes ' DoCmd.OpenForm "22" ' Case vbNo ' DoCmd.OpenReport "33", acViewPreview ' Case vbCancel ' Exit Sub 'End Select '--------------- '... End Sub

ربما غايتك النتائج بتقويم أم القرى، إذا كان كذلك فاستخدم التنسيق الآتي لخلايا التاريخ الهجري: [$-1170000]B2dd/mm/yyyy;@

محاولتي =IF(F2="","",IF(F2<E2,"-","")&TEXT(ABS(F2-E2),"hh:mm")) TRIP_01.xlsx

سبحان الله، الموضوع كان نشط وبمجرد شاركت أنا فيه نام وخمد!! نفس الفكرة ولكن من خلال زر ارقام النتائج عربي_05.xlsm