Foksh

وعليكم السلام ورحمة الله وبركاته .. أستاذنا الكبير ، هل أفهم أنك تريد استخراج الأيقونة من ملف Shell32 وحفظها كأيقونة ، أم كصورة ؟؟؟؟

تم تحميل الملف ، ولم تظهر اي مشكلة أو تعارض مع الأنتي فايروس

مشاركة مع الأستاذ @Barna ، لاحظ أخي الكريم @tiger wanted أن الكود الذي ارفقته سيعتمد على :- 1. القيمتين SID و Token من حسابك في شركة Twilio الخاص بك ، فهل تملك حساب للحصول على المفتاحين لتستطيع استخدام الخدمة ؟؟ 2. لاحظ في هذه العبارة From=whatsapp:14155238886 ، أن المستخدم خصص رقم هاتف لأرسال رسالة واتس أب ، فهل هذا رقمك ؟؟؟؟؟؟ 3. في معظم الخدمات التي تستخدم خدمات API يجب توافر مكتبة JSON الخاصة بالخدمة لتستطيع الأرسال و تلقي الرد من خلال آكسيس . لذا فأن الكود لن يعمل معك لأنك ستحتاج ارقام خاصة بحسابك في هذه الخدمة لدمجها في الكود .

حمد لله على سلامتك أستاذ خليفة . ونسأل الله أن تكون بصحة وعافية 💐

تأكد مما يلي :- 1. مركز التوثيق :- 2. تفعيل الماكرو :- 3. والأهم من هذا ، هو التأكد من لغة الـ Unicode في الويندوز :- 4. إحتمالية ضرورة عمل ضغط وإصلاح لقاعدة البيانات . هذا إجمالاً ما قد يسبب هذه المشكلة ( بالإعتماد أن قاعدة البيانات تعمل بشكل طبيعي على أجهزة أخرى ) .

وعليكم السلام ورحمة الله وبركاته أخي @nabilbibo2255 ، وأهلاً وسهلاً بك معنا في اسرة هذا المنتدى الكبير . أولاً أدعوك للمساهمة في تطبيق أساسيات وقوانين المنتدى عند نشر أي موضوع ، بحيث :- 1. يكون العنوان صريح ودال على المطلوب . 2. الشرح الوافي الكافي الشافي للمشكلة . 3. ارفاق ملف مرفق يساعد ويدعم في إيجاد حل على أرض الواقع . 4. لا تحاول استخدام مسميات الحقول والعناصر في المشروع بأسماء عربية أو ذات رموز أو أرقام فقط . أما فيما يتعلق بسؤالك ، فأنصحك باستعمال علامات التكويد <> لوضع الكود بدلاً من الصورة ، ليسهل قراءته والتعامل معه ممن يحاول ان يساعدك في الحل . لاحظت ان الكود يعمل بشكل سليم إلى حد ما ، ولكن المشكلة تكمن في الشروط التي على أساسها سيتم فتح النموذج . Private Sub Form_Load() On Error Resume Next Dim xx As Integer xx = Nz(DCount("[IDEmp]", "fin_ssolde"), 0) If xx > 0 Then Beep If MsgBox("هناك " & xx & " موظف(ين) انتهت عقودهم. هل ترغب في عرض التفاصيل؟", _ vbYesNo + vbMsgBoxRight, "تنبيه") = vbYes Then DoCmd.OpenForm "fin_ssolde", acNormal Else DoCmd.OpenForm "frm_F20", acNormal End If Else DoCmd.OpenForm "frm_F20", acNormal End If End Sub حاول وأخبرنا بالنتيجة ..

طبعاً الصورة من جدول اكسيل ، وانت تريدها في آكسيس ، صحيح ؟؟؟ الفكرة التي كانت موجودة سابقاً في أحد مشاريعي مشابهة لطلبك ولكن دون استثناء اي يوم ، والبداية من أول يوم في السنة . الفكرة تم تعديلها بحيث تم انشاء نموذج يحتوي كومبوبوكس يحتوي ارقام السنوات ( 2020 ، 2021 ، 2022 ، ..... 2030 ) . وكود المديول التالي الذي يتم استدعائه في زر :- Public Sub GenerateDatesTbl() Dim db As DAO.Database Dim rs As DAO.Recordset Dim startDate As Date Dim endDate As Date Dim currentDate As Date Dim yearSelected As Integer Dim dayName As String Dim sqlCreateTable As String Dim activeForm As Form Dim tableExists As Boolean On Error Resume Next Set activeForm = Screen.activeForm On Error GoTo 0 yearSelected = Nz(activeForm!Tx_Years.Value, 0) If yearSelected = 0 Then MsgBox "يرجى اختيار السنة أولاً", vbExclamation, "تنبيه" Exit Sub End If startDate = DateSerial(yearSelected, 12, 21) endDate = DateSerial(yearSelected + 1, 12, 20) tableExists = False Set db = CurrentDb On Error Resume Next tableExists = Not IsNull(db.TableDefs("TempDates").Name) On Error GoTo 0 If Not tableExists Then sqlCreateTable = "CREATE TABLE TempDates (ID COUNTER PRIMARY KEY, " & _ "DayName TEXT(50), DateValue DATE)" db.Execute sqlCreateTable DoCmd.SelectObject acTable, TempDates, True End If Set rs = db.OpenRecordset("TempDates", dbOpenDynaset) db.Execute "DELETE FROM TempDates" currentDate = startDate Do While currentDate <= endDate dayName = Format(currentDate, "dddd") If dayName <> "Friday" And dayName <> "Sunday" Then rs.AddNew rs!dayName = dayName rs!DateValue = currentDate rs.Update End If currentDate = currentDate + 1 Loop rs.Close Set rs = Nothing Set db = Nothing MsgBox "تم إنشاء التواريخ بنجاح", vbInformation, "نجاح" End Sub حيث بعد الاستدعاء سيتم انشاء جدول افتراضي يحتوي 3 حقول ( حقل الترقيم التلقائي ، وحقل اسم اليوم ، وحقل تاريخ اليوم ) . وسلامتكم والملف المرفق Insert Date.accdb

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

وعليكم السلام ورحمة الله وبركاته .. جرب هذا الكود بعد التعديلات على زر الفلترة :- Private Sub Cm1_Click() Dim filterCondition As String Dim formattedDate As String filterCondition = "" If Not IsNull(Me.tx1) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If filterCondition = filterCondition & "nom = '" & Replace(Me.tx1, "'", "''") & "'" End If If Not IsNull(Me.tx2) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If formattedDate = "#" & Format(Me.tx2, "MM/DD/YYYY") & "#" filterCondition = filterCondition & "moveDate = " & formattedDate End If If filterCondition <> "" Then Me.Filter = filterCondition Me.FilterOn = True Else Me.FilterOn = False End If End Sub في الكود تم استخدام دالة Replace لتأمين النصوص في حقل tx1 ضد الأخطاء الناتجة عن علامات الاقتباس المفردة . وتنسيق التاريخ فقط . اما في الكود التالي ، فقط استخدمت تنسيق التاريخ ؛ وبدلاً من استخدام علامة الاقتباس المفردة ' لتطويق النصوص ، استخدمت علامتي اقتباس مزدوجتين """ لتجنب أي مشكلات ناتجة عن وجود اقتباسات مفردة داخل النصوص . Private Sub Cm1_Click() Dim filterCondition As String Dim formattedDate As String filterCondition = "" If Not IsNull(Me.tx1) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If filterCondition = filterCondition & "nom = """ & Me.tx1 & """" End If If Not IsNull(Me.tx2) Then If filterCondition <> "" Then filterCondition = filterCondition & " AND " End If formattedDate = "#" & Format(Me.tx2, "MM/DD/YYYY") & "#" filterCondition = filterCondition & "moveDate = " & formattedDate End If If filterCondition <> "" Then Me.Filter = filterCondition Me.FilterOn = True Else Me.FilterOn = False End If End Sub

حسب تجاربي السابقة = نعم نعم يوجد طرق ملتوية لكسر حماية قاعدة البيانات نعم ، لكني لم اعمل بها

نعم يوجد بلا شك .. أولاً كلمة سر لقاعدة البيانات ( ولا أقصد الأكود VBA ) .. ثم حفظ قاعدة البيانات بامتداد Accde فقط !!!!!!! ولحماية جداولك وبياناتك ( سبق التطرق لهذه النقطة في عدة مواضيع في المنتدى )

نعم

أخي @سامر محمود ,, بالنسبة للنقطة :- فحلها بسيط وهو أن تضع معيار في الاستعلام Delay report في حقل "وقت الحضور" = >#9:30:00 AM# . أما في هذه النقطة :- فتستطيع باستخدام الاستعلام ان تحصي عدد تكرارات التأخير لكل موظف ، وأن تطبق لائحة العقوبات التي تريدها . وفي هذه النقطة قمت بإضافة بإضافة العقوبات حسب عدد التكرارات و إضافة عقوبات جديدة تستطيع حذفها كيفما تريد ) هذا الاستعلام يجلب لك الموظفين المتأخرين :- SELECT Att_Details.serial, Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Att_Details.[نوع الحركة], Att_Details.[تاريخ الحركة], Att_Details.[وقت الحضور], Att_Details.[وقت الانصراف], Att_Details.الفرق, Att_Details.الملاحظات FROM Att_Details WHERE Att_Details.[وقت الحضور] > #09:30:00 AM#; وهذا الاستعلام يقوم بعد تكرارات التأخير فقط :- SELECT Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة],"yyyy/mm") AS الشهر, Count(*) AS التكرار FROM Att_Details WHERE (((Att_Details.[وقت الحضور])>#12/30/1899 9:30:0#)) GROUP BY Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة],"yyyy/mm"); والإستعلام الأخير يقوم بعد التكرارات وبناءً عليها يطبق العقوبات :- SELECT Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة], "yyyy/mm") AS الشهر, COUNT(*) AS التكرار, IIf(COUNT(*) = 1, "إنذار", IIf(COUNT(*) > 1 AND COUNT(*) < 6, "ربع يوم", IIf(COUNT(*) > 5 AND COUNT(*) < 11, "نصف يوم", "خصم يوم"))) AS الإجراء FROM Att_Details WHERE Att_Details.[وقت الحضور] > #09:30:00 AM# GROUP BY Att_Details.[رقم الموظف], Att_Details.[اسم الموظف], Format(Att_Details.[تاريخ الحركة], "yyyy/mm"); والملف بعد التعديل :- Att - Copy.accdb

أخي @jo_2010 ، قمت بتعديل بسيط على ملفك ، وهو إضافة حقل جديد = PathPic في الجدول لتخزين المسار فيه بشكل صريح بدلاً من الطريقة التي يم فيها جلب مسار الملف لحذفه ، وأصبح الكود بعد تعديله في زر الحذف بالشكل التالي :- On Error GoTo HandleError Dim fileToDelete As String Dim response As VbMsgBoxResult Dim db As DAO.Database Dim sql As String Dim recordID As String Dim subFolderPath As String recordID = [Forms]![frm_sader_wared]![Pname].Value subFolderPath = CurrentProject.Path & "\AttachedFiles\" & recordID fileToDelete = Me.PathPic.Value If Not IsNull(fileToDelete) And Dir(fileToDelete) <> "" Then response = MsgBox("هل تريد حقاً حذف هذا الملف؟", vbYesNo + vbQuestion, "تأكيد الحذف") If response = vbYes Then Kill fileToDelete Set db = CurrentDb() sql = "DELETE FROM TblAttchedFiles WHERE id=" & Me.ID db.Execute sql, dbFailOnError On Error Resume Next RmDir subFolderPath On Error GoTo HandleError Me.Requery End If Else MsgBox "لا يوجد شئ لحذفه", vbExclamation, "خطأ" End If HandleExit: Exit Sub HandleError: Select Case Err.Number Case 94 MsgBox "لا يوجد شئ لحذفه", vbExclamation, "خطأ" Case Else MsgBox "خطأ رقم: " & Err.Number & vbNewLine & Err.Description, vbCritical, "خطأ" End Select Resume HandleExit وهذا ملفك بعد التعديل base_s_w.accdb