ناقل

اضم صوتي لصوت مشرفنا الغالي

وهذا حل ثالث اقصر Function JosephusOneLine(n As Integer) As Integer JosephusOneLine = 2 * (n - 2 ^ Int(Log(n) / Log(2))) + 1 End Function

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

ههه ..... انا اشارك ام ممنوع من المشاركة 😷

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

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

جزاك الله خيرا ... يبدو المشكلة لدي

تفضل بارك الله فيك ..................

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

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

جزاك الله خيرا استاذي الفاضل @ابو جودي الان اكملت دراستك الاكواد وفهم تفاصيل عملها ..... ممتازة الفكرة جدا بارك الله في عملك وعلمك وعمرك

سامحني اخي الكريم بسؤال ::::: ما هي فائدة هذا الملف CLR_Fallback

العين لا تعلو على الحاجب 😁

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

جرب مع تغيير نوع مصدر الصف الى قائمة وتعديل مسمي الكمبو لديك Private Sub cmb_mjal_Enter() Dim currentValue As String currentValue = Nz(Me.cmb_mjal.Value, "") Select Case currentValue Case "فردي1", "فردي2" Me.cmb_mjal.RowSource = "فردي1;فردي2;شامل1;شامل2" Case "زوجي" Me.cmb_mjal.RowSource = "زوجي;شامل1;شامل2" Case Else ' لو لم يتم اختيار شيء بعد، يظهر الكل Me.cmb_mjal.RowSource = "فردي1;فردي2;زوجي;شامل1;شامل2" End Select End Sub

تفضل جرب ..... كشف الحضور.accdb

شاهدت في المنتدى برنامج حماية شبيه لما طلبت اعتقد للاستاذ @Barna بهذه الصورة ..... ابحث عنه في المنتدى .... ,انا ابحث عنه اذا وجدته ادرجه هنا لك ...

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

جرب هذه الدالة IIf(Hour([chekin]) < 12, "الصباح", "المساء") لم اجربها ...

استخدم التنسيق الشرطي .... افضل .... انظر

طيب جرب هذا الكود بدل الموجود تحت الزر عندك .... On Error GoTo ErrorHandler Dim db As DAO.Database Dim rsEmp As DAO.Recordset Dim rsHol As DAO.Recordset Dim strSQL As String Dim intCount As Integer Dim blnExists As Boolean ' التحقق من وجود تاريخ في مربع النص If IsNull(Me.Controls("نص11").Value) Or Me.Controls("نص11").Value = "" Then MsgBox "الرجاء إدخال تاريخ في مربع النص نص11", vbExclamation, "تاريخ مفقود" Exit Sub End If ' التحقق من أن القيمة تاريخ صحيح If Not IsDate(Me.Controls("نص11").Value) Then MsgBox "القيمة في مربع النص ليست تاريخاً صحيحاً", vbExclamation, "تاريخ غير صالح" Exit Sub End If Me.Recalc ' فتح اتصال بقاعدة البيانات Set db = CurrentDb() ' إنشاء سجل مجموعة لجدول الموظفين (emp) حيث att = "غياب" strSQL = " SELECT emp.[no], emp.Att " & _ " FROM emp " & _ " WHERE (((emp.Att)="" غياب""));" Set rsEmp = db.OpenRecordset(strSQL) ' التحقق من وجود سجلات If rsEmp.EOF And rsEmp.BOF Then MsgBox "لا توجد سجلات غياب في جدول الموظفين", vbInformation, "لا توجد بيانات" GoTo CleanUp End If ' فتح جدول hol للكتابة Set rsHol = db.OpenRecordset("hol") ' بدء عملية الإدراج intCount = 0 Do Until rsEmp.EOF ' التحقق من عدم وجود سجل مكرر blnExists = DCount("[no]", "[hol]", "[absdate] =#" & [Forms]![تسجيل الحضور والغياب]![نص11] & "# And [no] =" & rsEmp!no & " ") If Not blnExists Then On Error Resume Next ' لتجنب أخطاء الإدراج rsHol.AddNew rsHol!no.Value = rsEmp!no.Value rsHol!absDate.Value = [Forms]![تسجيل الحضور والغياب]![نص11] rsHol.Update If Err.Number = 0 Then intCount = intCount + 1 Else MsgBox "خطأ في إدراج سجل للموظف رقم " & rsEmp!no & ": " & Err.Description, vbExclamation Err.Clear End If On Error GoTo ErrorHandler Else MsgBox "تم تجاهل الموظف رقم " & rsEmp!no & " لأنه مسجل غياب بالفعل في هذا التاريخ", vbExclamation, "سجل مكرر" End If rsEmp.MoveNext Loop MsgBox "تم إدراج " & intCount & " سجل غياب بنجاح", vbInformation, "تمت العملية" CleanUp: On Error Resume Next If Not rsEmp Is Nothing Then rsEmp.Close Set rsEmp = Nothing End If If Not rsHol Is Nothing Then rsHol.Close Set rsHol = Nothing End If Set db = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description & " (السطر: " & Erl & ")", vbCritical, "خطأ" Resume CleanUp

تفضل ملفك ..... NA_1.accdb الرسالة تظهر عند الضغط على اضافة

غير الشيفرة الموجودة تحث حدث الزر الى .... Me.Recalc If DLookup("[absdate]", "[hol]", "[absdate] =#" & [Forms]![تسجيل الحضور والغياب]![نص11] & "#") Then MsgBox "تم تسجيل غياب هذا اليوم" Else DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO hol ( [no], absdate ) " & _ " SELECT emp.[no], [forms]![تسجيل الحضور والغياب]![نص11] AS Expr1 " & _ " FROM emp " & _ " WHERE (((emp.Att)="" غياب""));" DoCmd.RunSQL "UPDATE emp SET emp.Att = """";" DoCmd.SetWarnings True End If

اضفت حقل صغير في جدول الموظفين...... جرب الملف NA_1.accdb

الف مبروك اخي الكريم .... مزيدا من التألق