نجوم المشاركات

يمكنك استعمال هذه المعادلة للحصول على الرقم الأول =MID(A2,1,FIND("°",A2)-1) وهذه للرقم الثاني =MID(A2,FIND("°",A2)+2,FIND("'",A2)-FIND("°",A2)-2) وبعد دراسة هاتين المعادلتين يمكنك التوصل للرقم الثالث بالتوفيق

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

اخي سعد صفحة المطور ليس لها علاقة بملف او مصنف معين.هي إعدادات خاصة بنسخة الأوفيس. يتم تحديدها من طرفك بالشكل الذي تريد. ربما وبدون قصد تم حذف او إضافة نافذة معينة أو شيء من هذا القبيل من المطور واصبح بشكل انت غير متعود عليه. كما سميتها انت باللخبطة. اسهل طريقة بالنسبة لك هي إعادة نسخة الأوفيس للوضع الافتراضي

Sub test1() Dim WS As Worksheet: Set WS = ActiveSheet '<<<---- Worksheets("27-10-2023الى2-11-2023") 'اسم ورقة العمل Dim lastrow As Long, ligne As Range, search As Rang Set ligne = [U4] '<<<----' خلية اللصق Set search = [L19] '<<<-- اي القيمة التي تم جلبها من الخلية '<<<---اول تاريخ على الجدول ("A4") ' '("U")' تحديد اخر خلية بها بيانات من عمود lastrow = WS.Cells(Rows.Count, 23).End(xlUp).Row + 1 ' لمنع التكرار '*********************** '("U") 'التحقق من وجود نفس تاريخ المدفوعات مسبقا في عمود ' ' في حالة وجوده يتم ايقاف تنفيد الكود مع رسالة اشعار If Application.WorksheetFunction.CountIf(WS.Range("U:U"), search) > 0 Then MsgBox " يوجد نفس الفترة في المدفوعات " & search, vbOKOnly + vbCritical + vbDefaultButton1 + vbApplicationModal, "انتباه": Exit Sub A = [L19:Q51].Value ''<<<----'نطاق البيانات المرحلة If ligne = 0 Then ' '<<<----التحقق من عدم وجود قيمة في خلية اللصق ' U4'في حالة فراغها يتم لصق البيانات ابتداءا من الخلية [U4].Resize(UBound(A), UBound(A, 2)).Value2 = A Else ' U ' في حالةوجودقيمة يتم لصق البيانات بعد اخر صف به بيانات من عمود Range("U" & lastrow).Resize(UBound(A), UBound(A, 2)).Value2 = A End If MsgBox "تم ترحيل مدفوعات" & " " & search & " " & "بنجاح", vbInformation End Sub

السلام عليكم و رحمة الله استخدم هذه الدالة المعرفة عليك بتحديد الصف الاول الذى سوف يتم جمعه Rng و من ثم استخراج النسبة المحددة و السحب لاسفل Function AllPerc(Rng As Range) As Double Dim x As Integer, y x = WorksheetFunction.Sum(Rng.Value) If x >= 8001 Then: y = x * 0.045 '-------------------- ElseIf x >= 7501 Then: y = x * 0.0425 '-------------------- ElseIf x >= 7001 Then: y = x * 0.0375 '-------------------- ElseIf x >= 6001 Then: y = x * 0.03 '-------------------- ElseIf x >= 5501 Then: y = x * 0.025 '-------------------- ElseIf x >= 5001 Then: y = x * 0.0175 '-------------------- ElseIf x >= 4501 Then: y = x * 0.015 '-------------------- ElseIf x >= 4001 Then: y = x * 0.01 '-------------------- ElseIf x >= 3001 Then: y = x * 0.005 '-------------------- Else y = 0 End If AllPerc = y End Function

بعد اذن استاذى الجليل / @ابوخليل هل جربت هذا الموضوع ممكن تلاقى ما تريد فى نظام الحضور والانصراف للموظفين هنا انا كنت عامل حاجه زي كده زمان جرب وان شاء الله هتلاقى ما تريد

لم أنتبه للردود .. وشاركت مع الإخوة 🙂 date.mdb

تفضل استاذ @waheidi2005 محاولتي ووافني بالرد................. انا مغير بعض اسماء الحقول لترتيب عملي مثل y1) الى (T) DD410.rar

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

يمكنك تجربة هذه المعادلة =MID(A2,FIND("|AR|",A2)+4,100) بالتوفيق

حاول اخي قبل الغاء تثبيت نسخة الاوفيس من الجهاز تجربت إعادة تعيين Microsoft Excel إلى الإعدادات الافتراضية ربما تفيدك

أخي الكريم لي ملاحظتين لم تأخذهم بعين الإعتبار حتى تلقى الإجابة الصحيحة أو الشافية لطلبك :- لاحظ أن العنوان ( رصد التغييرات اثناء اليوم بالجداول ) وهو من الواضح أنك تريد تسجيل جميع التغييرات والتحركات التي تحدث داخل جدول معين ، صحيح ؟؟ * وهو ما تقدم به الأستاذ @عمر ضاحى للمساعدة . و المعاكس له في المضمون هو طلبك التفصيلي داخل الشرح وهو ( عندي استعلام بطله تقرير مدخلات اليوم الجديدة للموظفين لكن في موظفين بيتم اعادة تعيينهم مرة اخري عن طريق افعيل شاشتهم ( يعمل ) دول مش بيظهروا في تقرير نهاية اليوم هل في طريقة لمعرفة ذلك في الاستعلام ) ، لإيهما تريد الإجابة عنه ؟

بص علاج موضوعك هنا من الاخر

اعمل ضغط للملف واذا كان حجم البرنامج كبير اعمل نسخة أخرى واحذف جميع الجداول والنماذج والتقارير واحتفظ فقط بالمطلوب لحل المشكلة

ربما يفيدك عمل إصلاح للأوفيس repair من لوحة التحكم ثم الغاء تثبيت البرامج ثم تختار إصلاح وليس إلغاء تثبيت بالتوفيق

تفضل هذا هو كود النسخة الاحتياطية بإختصار لإنشاء نسخة احتياطة من القاعدة الحالية Dim MyFile As String Dim DstFile As String Dim Syso As Object Dim GetType As Variant MyFile = CurrentProject.FullName ' مسار القاعدة الحالية GetType = Right$(MyFile, Len(MyFile) - InStrRev(MyFile, ".")) DstFile = CurrentProject.Path & "\" & Format(Now, "dd-mm-yyyy-nss") & "." & GetType ' الاسم الجديد للنسخة الاحتياطية DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Name DstFile As DstFile & ".ptc" DBEngine.CompactDatabase DstFile & ".ptc", DstFile Kill DstFile & ".ptc" لإنشاء نسخة احتياطية لقاعدة البيانات في حال ان القاعدة منفصلة عن الواجهة Dim MyFile As String Dim DstFile As String Dim Syso As Object Dim GetType As Variant MyFile = CurrentProject.FullName ' مسار قاعدة البيانات GetType = Right$(MyFile, Len(MyFile) - InStrRev(MyFile, ".")) DstFile = CurrentProject.Path & "\" & Format(Now, "dd-mm-yyyy-hnss") & "." & GetType ' الاسم الجديد للنسخة الاحتياطية Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing

تفضل أخي . Backup.mdb

تفضل أخي قاعدة من تصميم أحد عمالقة المنتدى ومسامحة لم أتذكر الاسم . يعمل لدي بكفاءة ولايوجد به أخطاء . Backup.rar