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

وعليكم السلام ورحمة الله تعالى وبركاته ممكن توضح لنا ما المانع من إظافة عمود التسلسل يدويا وإعادة تعديل الكود بما يتناسب مع شكل البيانات ؟ اذا كان هذا يناسبك إليك الكود المعدل Sub DeleteRows() Dim WS As Worksheet, lastRow As Long, i As Long, OnRng As Range, response As VbMsgBoxResult Set WS = Sheets("ورقة1") lastRow = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row response = MsgBox("هل أنت متأكد أنك تريد حذف من استلمو الاول والثاني ؟", vbYesNo + vbQuestion, "تأكيد الحذف") If response = vbYes Then For i = lastRow To 3 Step -1 If WS.Cells(i, 3).Value <> "" And WS.Cells(i, 4).Value <> "" Then If OnRng Is Nothing Then Set OnRng = WS.Rows(i) Else Set OnRng = Union(OnRng, WS.Rows(i)) End If End If Next i If Not OnRng Is Nothing Then OnRng.Delete MsgBox OnRng.Count & " تم حذف الصفوف بنجاح", vbInformation, "عملية الحذف" Else MsgBox "لا توجد صفوف مطابقة للحذف", vbExclamation, "لم يتم الحذف" End If Else MsgBox "تم إلغاء عملية الحذف", vbInformation, "إلغاء" Exit Sub End If With WS.Range("A1:E50").Font .Name = "Arial": .Size = 16: .Bold = True: .Color = RGB(0, 0, 251) End With For i = 3 To WS.Cells(WS.Rows.Count, "B").End(xlUp).Row WS.Cells(i, 1).Value = i - 2 Next i With WS.PageSetup .TopMargin = .BottomMargin = .LeftMargin = .RightMargin = Application.InchesToPoints(0.5) End With WS.[C1].Value = Date - 1: WS.[C1].NumberFormat = "dd/mm/yyyy" WS.[B1].Value = Format(Date - 1, "dddd") Application.ScreenUpdating = True End Sub مثال1.xlsm

أخي @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

اخي @أبوالباسل دالة VLOOKUP لديها قاعدة أساسية يجب الإنتباه إليها فهي تعمل فقط من اليسار إلى اليمين بمعنى تبحث دائما في العمود الأول من النطاق المحدد وهو في حالتك العمود G لكنك تريد البحث عن رقم سير باستخدام العمود H (الذي يحتوي على أسماء العملاء) وهذا يخالف طريقة عمل VLOOKUP لأن العمود H ليس العمود الأول بإختصار دالة VLOOKUP لا يمكنها البحث في عمود ليس هو الأول ضمن نطاق البيانات لهدا حاولنا إستخدام بدائل أخرى مثل INDEX و MATCH هذه الدوال لا تعتمد على ترتيب الأعمدة للتوضيح أكثر حاول عكس ترتيب الأعمدة بجعل عمود أسماء العملاء على اليمين وجعل عمود سير يسارا ووضع المعادلة الخاصة بك على الشكل التالي =IF(C3<>"", IFERROR(VLOOKUP(C3, $G$3:$H$121, 2, 0), "غير موجود"), "") كما تلاحظ VLOOKUP الآن تبحث في العمود H (أسماء العملاء) لأنه أصبح العمود الأول و تسترجع القيمة المقابلة من العمود G (سير ) بنجاح خط السير-VLOOKUP.xlsx

تفضل أخي تم تعديل الكود السابق وإظافة إمكانية تحديد الأعمدة المرحلة والمرحل إليها لتتمكن من تعديله بما يناسبك لاحقا Option Explicit Dim tmp As Variant Const tmpCol As String = "G" Private Sub Worksheet_Change(ByVal Target As Range) Dim arr(3) As Worksheet, OnRng As Range, Irow As Long, ling As Variant Set arr(0) = Sheets("بطاقة صنف"): Set arr(1) = Sheets("اضافة") Set arr(2) = Sheets("الصرف"): Set arr(3) = Sheets("الأصناف") If Not Intersect(Target, Me.Range("J2:I3")) Is Nothing Then SetApp False Set OnRng = arr(0).Range("B6:I" & arr(0).Rows.Count) OnRng.ClearContents Irow = arr(3).Cells(arr(3).Rows.Count, 1).End(xlUp).Row Me.Range("I3").Formula = "=IFERROR(VLOOKUP($J$2,'الأصناف'!$A$3:$B$" & Irow & ",2,0),"""")" Me.Range("I3").Value = Me.Range("I3").Value ling = Me.Range("I3").Value If Not IsEmpty(ling) And ling <> "" Then tmp = ling Call Cnt(arr(1), arr(0), ling, Array(4, 9, 10, 14, 16), Array(3, 5, 6, 4, 2)) Call Cnt(arr(2), arr(0), ling, Array(4, 19, 17, 9, 10, 11), Array(3, 2, 4, 7, 8, 9)) Else OnRng.ClearContents GoTo AppTrue End If AppTrue: SetApp True End If End Sub '"""""""""""""""""""""""""""""""""""" Private Sub Cnt(ByVal dest As Worksheet, ByVal tbl As Worksheet, _ ByVal temp As Variant, ByVal Colky As Variant, ByVal DestCols As Variant) Dim i As Long, x As Long, LastRow As Long, n As Long, Cel As Range, début As Long, fin As Long LastRow = dest.Cells(dest.Rows.Count, tmpCol).End(xlUp).Row début = 3 fin = LastRow For i = début To fin With dest If Not IsEmpty(.Cells(i, tmpCol).Value) And Not IsError(.Cells(i, tmpCol).Value) Then If .Cells(i, tmpCol).Value = temp Then x = WorksheetFunction.CountA(tbl.Range("B6:B1000")) For n = LBound(Colky) To UBound(Colky) Set Cel = tbl.Cells(6 + x, DestCols(n)) Cel.Value = .Cells(i, Colky(n)).Value Next n End If End If End With Next i End Sub '""""""""""""""""""""""""""""" Private Sub SetApp(ByVal Enable As Boolean) Application.ScreenUpdating = Enable Application.EnableEvents = Enable Application.Calculation = IIf(Enable, xlCalculationAutomatic, xlCalculationManual) End Sub مخازن 2024مكرو v3.xlsm

السلام عليكم ورحمه الله وبركاته اسعد الله اوقاتكم بكل خير تكمله لما سبق :-- عملية برمجة نظام إدارة الفواتير الضريبية: دراسة تفصيلية تم بحمدالله تصميم وتطوير نظام صغير لإدارة الفواتير الضريبية والإشعارات الخاصة بهيئة الزكاة والضريبة والجمارك، كان الهدف الأساسي هو بناء حل برمجي يلبي جميع متطلبات الهيئة، بما في ذلك تصدير الفواتير بتنسيق XML، التوقيع الرقمي، إنشاء رموز QR، وتصدير الفواتير بصيغة PDF. فيما يلي تفاصيل العمليات البرمجية التي تمت أثناء تطوير النظام: 1. إنشاء قاعدة بيانات شاملة باستخدام Microsoft Access تصميم الجداول: تم إنشاء جداول تحتوي على معلومات العملاء، المنتجات، تفاصيل الفواتير، والضرائب. تم تصميم هذه الجداول بطريقة مترابطة باستخدام المفاتيح الأساسية (Primary Keys) والمفاتيح الخارجية (Foreign Keys) لضمان التكامل بين البيانات. تصميم النماذج (Forms): استخدمت النماذج كواجهة للمستخدم لإدخال بيانات الفواتير بسهولة. تم إضافة ميزات التحقق من صحة البيانات (Validation Rules) للتأكد من إدخال البيانات بطريقة صحيحة ودقيقة. 2. تصدير الفواتير إلى صيغة XML التحليل الأولي لتنسيق XML المطلوب: تمت دراسة هيكلية الملفات المطلوبة من هيئة الزكاة والضريبة لتحديد جميع العناصر والمكونات مثل الرقم الضريبي، المبالغ، ونسب الضريبة. كتابة الأكواد لتوليد XML: باستخدام VBA (Visual Basic for Applications)، تمت كتابة الأكواد اللازمة لتحويل بيانات الفواتير المخزنة في قاعدة البيانات إلى ملف XML. تم استخدام مكتبة MSXML. 3. إضافة التوقيع الرقمي إلى الفواتير دمج شهادات التوقيع الرقمي: استخدمت مكتبة خارجية لدعم عملية التوقيع الإلكتروني. تضمنت العملية قراءة شهادة رقمية (Digital Certificate) وربطها بالبيانات المصدرة لضمان تأكيد صحة الفواتير وصلاحيتها. 4. إنشاء رموز QR للفواتير تحليل متطلبات QR Code: يحتوي رمز QR على بيانات مثل الرقم الضريبي، إجمالي الفاتورة، وتاريخ الإصدار. تم تشفير هذه البيانات باستخدام صيغة معتمدة من الهيئة. توليد QR Code برمجيًا: تم استخدام مكتبة خارجية لإنشاء رموز QR. تم تصميم الكود بحيث يتم توليد رمز QR وحفظه كصورة (Image) وربطه بملف الفاتورة. 5. تصدير الفاتورة إلى PDF إعداد التقارير (Reports): تم تصميم تقارير داخل Access لعرض الفواتير بشكل منظم واحترافي. تصدير التقرير إلى PDF: تم استخدام أمر DoCmd.OutputTo لتصدير التقرير بصيغة PDF. دمج رمز QR مع التقرير: تمت برمجة التقرير ليعرض رمز QR بشكل تلقائي داخل الملف المصدر. 6. معالجة الأخطاء وتحسين الأداء التعامل مع الأخطاء البرمجية: أثناء التطوير، ظهرت أخطاء تم كتابة أكواد لإدارة الأخطاء (Error Handling) والتأكد من تنفيذ الأوامر بسلاسة. تحسين الأداء: تم تحسين الأكواد لضمان تنفيذ العمليات بكفاءة، خاصة عند التعامل مع ملفات XML والفواتير الكبيرة. التحديات البرمجية توافق البيانات مع متطلبات الهيئة: كان من الضروري ضبط كل تفاصيل الفواتير لتطابق متطلبات هيئة الزكاة. تكامل العمليات: تنسيق العمليات المختلفة (XML، QR، PDF) وضمان عملها بانسجام شكل تحديًا تقنيًا، وتم تحقيقه بحمدالله النهاية النظام الناتج يعكس عملية برمجية متكاملة، تم فيها المزج بين التحليل الدقيق، كتابة الأكواد الفعالة، وحل التحديات بطريقة مبتكرة. ساهم هذا المشروع في بناء أداة عملية تلبي احتياجات الأعمال وتحقق الالتزام الكامل بلوائح الفوترة الإلكترونية. =========رابط الشرح جاري الرفع :- الملفات :- https://drive.google.com/file/d/1nhStXOT_w1OlTANO4KnI9l_asDIFcIE1/view?usp=drive_link ملحوظه:- الفديوهات هتكون طويله شويه بالتوفيق للجميع

السلام عليكم ورحمة الله تعالى وبركاته طبعا قد يقول البعض ان الموضوع اتهرس فى ميت فيلم عربى قبل كده لكن على كل حال تم تدارك الكثير من المشاكل ومعالجتها بشكل احترافى - اخفاء اطار لاكسس بالشكل الطبيعى والتقليدى لعرض النموذج كاملا - اخفاء اطار الاكسس وعمل شفافية للنموذج لاظهار صور png او حسب خيال المسخدم - تم ضبط كواد التوسيط للنماذج والتقارير باحترافية ويعمل التوسيط مع الخاصية Pop Up فى اى وضع كانت فى حالة عدم استخدام الاخفاء - تم حل مشكلة عدم ظهور التقاربر عند الاخفاء بتكبير التقرير تلقائيا عند استخدام كود الاخفاء - امكانبة التصغير للتطبيق بجوار الساعة ( System Try ) - عند التصغير بجوار الساعة ممكن الضغط كليك يمين على الايقونة لتظهر قائمة اختيارات - تم ضبط كود تغير ايقونة الاكسس باحترافية وبشكل تلقائى من المسار المحدد او فى حالة عدم وجود الايقونة ترجع ايقونة الاكسس - تم التعامل مع الاكواد بحرفية تامة للعمل على بيئات الأنوية المختلفة سواء كانت 32 , 64 اترككم مع تجربة شيقة ملاحظة هامة : ارضاء للجميع ولاضفاء اكبر قدر ممكن من المرونة المرفق يحتوى على قاعدتان الاولى : تم تجميع كل الاكواد والدوال فى وحدة نمطية عامة واحدة وكلاس موديول واحد لسهولة الاستفادة منها ونقلهم الى اى قاعدة الثانية : فصل اكواد كل وظيفة على حدة فى مديول خاص بها تم اضافة تعديل وتحديث جديد بتاريخ 11/10/2024 رقم اصدار التعديل الاخيــر : 4.8 center and Hid and Tray Minimizer V 30.zip center and Hid and Tray Minimizer V 4.8.rar

كفكرة .. أعجبتني جميلة جدا ما شاء الله 🙂 وشكرا لك 🌷🙂 لكن أعتقد أنها محتاجة للكثير من التبسيط ليسهل استخدامها مع أي تقرير .. بحيث يتم عمل دالة Function خاصة لفتح التقرير المطلوب توضع على زر فتح التقرير المطلوب بدون تعقيدات 🙂👌🏻

طبعا مش جديد عليك والله دايما ضهر وسند وقت الحاجة تسلم يا اخي @Foksh

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

أنا متأكد ان الحلبي يسأل من اجل حماية نفسه .. وبياناته .. من باب العلم عن نفسي ومن باب التعلم حاولت مع امتداد mdb ونجحت ولم اقدر على accdb .. لذا اعتبرها اكثر أمانا

أخي @سامر محمود ,, بالنسبة للنقطة :- فحلها بسيط وهو أن تضع معيار في الاستعلام 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

الاستاذ والخبير الفاضل بعد التحية ممكن لو تكرمت مساعدتى فى الاستفادة من البرنامج الخاص بالاخ الفاضل moho58 تعديل كود الخذف ارجو اصلاح كود الحذف واضافة كود لحذف فولد الخاص باسم الشخص اذا كان فارغ ليس بة ملفات base_s_w.accdb

الخبير الفاضل Foksh خالص الشكر

يرجى الانتباه إلى أن مناقشة أو تقديم طرق لفك حماية قواعد البيانات يعتبر أمرًا حساسًا، حيث إن ذلك قد يؤثر سلبًا على حقوق المبرمجين والمطورين. نظرة عامة: قواعد البيانات بصيغة Accde أو Mde: هذه الصيغ محمية بشكل قوي، وبالتالي لا يُنصح بالبحث عن طرق لفك الحماية. قواعد البيانات بصيغة Accdb أو Mdb: في حالة العمل مع هذه الصيغ، هناك خيارات شرعية، مثل: إنشاء قاعدة بيانات جديدة: يمكنك استيراد المكونات مع مراعاة وجود كلمة المرور. ضرورة احترام حقوق المبرمجين: من المهم دائمًا احترم عمل الآخرين وعدم انتهاك حقوق الملكية الفكرية. نحن هنا لتقديم المساعدة والإرشادات، لكن من المهم أن نكون واعين للأثر الذي قد تحدثه أفعالنا على الآخرين في هذا المجال. ختامًا: إذا كانت لديك استفسارات أو تحتاج إلى مساعدة في جوانب أخرى ضمن البرمجة أو قواعد البيانات دون انتهاك الحقوق، فلا تتردد في طرحها!

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

وعليكم السلام ورحمه الله وبركاته اتفضل استاذ @mahmoud nasr alhasany ارجو ان يكون هذا هو المطلوب وليك الاكواد المستخدمه لتفعيل f4 يجب الوفقوف علي textbox3 وسيتم تشغيل الكود المجود فيه كما ترا ادناه Private Sub TextBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 115 Then CommandButton1_Click ' هنا ضع الامر الذي تريد تنفيذه بعد الضغط على زر انتر End If End Sub لتفعيل f4 يجب الوفقوف علي ListBox1 وسيتم تشغيل الكود المجود فيه كما ترا ادناه Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 113 Then CommandButton2_Click ' هنا ضع الامر الذي تريد تنفيذه بعد الضغط على زر انتر End If End Sub شاشة عميل بحث.xlsm شاشة عميل بحث.xlsm

تفضل هذا التعديل البسيط Database4.zip

السلام عليكم... شاهد هذا الفيديو ..قد تجد فيه ما ينفعك