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

In First worksheet in cell AH4 change the month to March then try the following code Sub Test() Dim x, ws As Worksheet, lr As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets(1) With ws lr = .Cells(Rows.Count, "B").End(xlUp).Row + 1 x = Application.Match(.Range("D2").Value2, .Rows(6), 0) If Not IsError(x) Then .Cells(lr, 1).Value = .Cells(lr, 1).Row - 6 .Cells(lr, 2).Value = .Range("B2").Value .Cells(lr, x).Resize(, .Range("F2").Value).Value = .Range("C2").Value End If End With Application.ScreenUpdating = True End Sub

أحسنت أخي الكريم @كريم نظيم إلا أنني قمت بالعمل وفق طلبه ...وماذا إن وضع حرفاً آخر غير حرف الغين؟!. كان بإمكاننا استخدام هذه الدالة التي استخدمتها . بارك الله بكم تقبل تحياتي العطرة.

السلام عليكم ورحمة الله وبركاتة هذا شيت لمحاسبة العمال بالساعة.... وضعتة للفائدة 1... اضافة عميل جديد 2... حزف عميل 3..كما يوجد التنقل بين العمال 4.... عند اختيار كلمة حضور من القائمة المنسدلة يتم كتابة اليوم والتاريخ والوقت تلقائي....وعند كتابة وقت الانصراف يتم حسابة الوقت والسعر الملف ‏‏برنامج محاسبة العامل بالساعة - نسخة.xlsm

وعليكم السلام استاذي ومعلمي القدير @محمد حسن المحمد اسمح لي بالمشاركه من باب التنوع وزياده السائل بالمعرفه استاذ @مصطفى العراقي1988 يمكن استخدام المعادله =COUNTIF(A3:F3,"*ع") مسودة.xlsx

وعليكم السلام يمكنك استخدام هذه المعادلة =COUNTA(A2:F2)-COUNTBLANK(A2:F2) واسحب نزولاً تقبل تحياتي

السلام عليكم ورحمة الله وبركاته يسرني اليوم أن أقدم لكم هذه الهدية المتميزة والمتواضعة ( زاد المثابر للحصول على أسماء العناصر) هذه الأداة صممتها بفضل الله في أكسس تقوم بإحضار وسرد أسماء العناصر لك لكي تستطيع نسخها ولصقها في أي مكان تريد بكل سهولة ويسر 🙂 شخصيا أستفدت كثيرا منها وسهلت علي الكثير من الجهد وقلصت من وقت العمل بحمد الله وفضله. وهنا اختصرت على نفسي الكتابة وقمت بشرح الأداة مرئيا 🙂 متابعة ممتعة 😊👌🏼 ولا أستغني عن آراءكم وملاحظاتكم .. 🙂 لتحميل الملف المستخدم في الشرح وبه النموذج : التحديث 2.0 : تم إضافة خاصية جلب عناصر النماذج الفرعية .. والتقارير الفرعية .. شكرا للأخ @عمر ضاحى على الفكرة 🙂

شكرا لك أخي @kanory على وضع بصمتك هنا🙂 وأنا أتشرف بكونك أول الحضور ☺️🌹

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

السلام عليكم اخي العزيز النموذج مصدر سجلاتة استعلام تفضل التعديل وفيه رسالة تنبيه اما الاستمرار باضافة الصنف او الغاء اضافة الصنف المكرر اتمنى ان يكون المطلوب تحياتي yasser_10.accdb

شكرا جزيلا لك معلمي الحبيب @Ahmed_J اسئل الله ان يوفقك ويزيدك من علمه وان يعطيك ما تتمناه وترجوه دائماً

I think this is a different request. Please post a new topic for the new question

Does the code raises any errors? The code is working well on my side. Just select the suitable month as the date in cell D2 is in March and the selected month is February

تفضل اخي ابو الحسن @abouelhassan هذا مثال لطيف من احد المواقع ولايحتاج لاستدعاء دوال API لكنه يحتاج الى تدريب قليلا لان يحتاج الى التعامل مع ال Tag لكل عنصر موجود في النموذج PDTech_FormResizer_code.rar

شفاك الله وعافاك من كل مكروه أخي ابو زاهر طهور إن شاء الله

استاذي ومعلمي @محمد حسن المحمد دايما بنتعلم من حضرتك واديما حضرتك سباق🌹 جزاك الله خيرا علي مجهوداتك الرائعه 🌹🌹

وعليكم السلام ورحمه الله وبركاته بارك الله فيكم وجزاكم الله خيرا على الموضوع الرائع 🌹

بسيطة وسهلة وذلك من خلال Conditional Formatting

مشاركة مع استاذي متقاعد تفضل أخي . t11 (3).accdb

تفضل أخي واذا كان هذا طلبك وافني بالرد . تقرير بين تاريخين.accdb

بارك الله فى جهودك

وعليكم السلام بارك الله فيك استاذ محمد وجعله الله فى ميزان حسناتك

مشاركة مع أخي kanory تفضل أخي . DD124.mdb

شفاك الله وعافاك من كل مكروه أخي @النجاشي طهور إن شاء الله

مشاركة مع استازي موسي تفضل أخي . DD123.accdb

شفاك الله وعافاك من كل مكروه أخي @النجاشي طهور إن شاء الله

شفاك الله عافك ... طهور أن شاء الله أسأل الله رب العرش العظيم أن يشافيك شفاءً لا يغادر سقما معذور لا عليك لن يقصر أحد ... فنحن اخوة جميعاً في الله وكل واحد يكمل الآخر

أسأل الله العظيم رب العرش العظيم أن يشفيك من مرضك شفاء لا يغادر سقماً، وأن يلبسك ثوب العافية والصحة.

جرب هذا ..... مع تعديل ما يلزم <><><><><<><><<>><><|> Dim x As Integer, mov_st As String Dim db As Database, rst As Recordset Set db = CurrentDb Set rst = db.OpenRecordset("SELECT doc.doc_ID, doc.mov_no, doc.mov, doc.mov2 FROM doc ORDER BY doc.doc_ID;") rst.MoveFirst x = 1 mov_st = rst!doc_ID Do While Not rst.EOF If mov_st <> rst!doc_ID Then x = 1 mov_st = rst!doc_ID End If rst.Edit rst!mov2 = x x = x + 1 rst.Update rst.MoveNext Loop MsgBox "تم توزيع الارقام ", vbInformation + vbMsgBoxRight + vbOKOnly, "برنامج" rst.Close Me.Refresh

إذا لم يكن يوافق المطلوب ، أرجو التوضيح أكثر Percentages_01.xlsx

رابط الملف والشرح الاصلي للملف: http://arabteam2000-forum.com/index.php?/topic/143691-تغيير-اشكال-نماذج-الأكسيس-بأشكال-جميله/#comment-724325 وفية شرح كامل لطريقة عمل الملف يبدو ان اخونا @النجاشي نسي التنبية انه يجب تثبيت المكتبات المرفقه لم اقم بتجربة الملف في الوقت الحالي ..

السلام عليكم ورحمة الله تعالى وبركاته على كل مصممى ومطورى قواعد البيانات ببساطة عند محاولة تشفير قاعدة البيانات الى accDE لابد من إنشاؤها مره باستخدام office (Access) x64 و إنشاؤها مره أخرى باستخدام office (Access) x32 حتى لا تحدث مشكلة عند العملاء بسبب إختلاف أنوية الأوفيس للاسف الشديد . للعلم الموضوع مختص فقط بتشفير القاعدة بالامتداد Accde فقط اى أنه لا علاقة للموضوع بالامتداد Accdb ولا علاقة للموضوع باستخدام دوال API حتى لو تم الاخذ فى الاعتبار عند كتابة الكود مراعاة عمل الكود عند استخدام دوال API على كلتا النواتان 64x , 32 x هذه لقطة من مقال المصدر : >>--> مايكروسوفت لذلك فإن accDE الخاص بـ x32 accDE و x64 خاصان جدًا بحجم النواه والبنية التي تم تجميعهما بها ويجب أن تعمل الأجهزة المستهدفة بنفس حجم النواة لاستعمال accDE الذي تم إنشاؤه باستخدامه ولا توجد استثناءات لهذه القاعدة

جرب هذا الكود Private Sub Command16_Click() Dim invRst As Recordset Dim itmRst As Recordset If vbNo = MsgBox("هل تريد حذف الفاتورة الحاليه ؟؟؟", vbYesNo + _ vbCritical + _ vbMsgBoxRight + _ vbDefaultButton2, "تحذير") Then Exit Sub End If Set itmRst = CurrentDb.OpenRecordset("Stor1", dbOpenDynaset) Set invRst = Me.frmPurches.Form.RecordsetClone invRst.Filter = "Add_doc=" & Me.Add_doc Set invRst = invRst.OpenRecordset With invRst invRst.MoveFirst Do While Not .EOF itmRst.FindFirst "Number1='" & !Number & "'" If Not .NoMatch Then itmRst.Edit itmRst!currentRased1 = itmRst!currentRased1 - !Qty_in itmRst.Update End If .MoveNext Loop End With Set invRst = Nothing Set itmRst = Nothing End Sub

طيب شوف كدة ..... kan_b.accdb

نعم وتفضل باستعلام تحديث (Query2) بالضغط عليه مرتان أو تشغيله من الفورم بزر أمر أو عند اي حدث ( عند غلق الفورم أو ................) اختار الحدث الذي يناسبك . Controler-2.accdb

In worksheet module, try the code Private Sub Worksheet_Change(ByVal Target As Range) Dim x, sh As Worksheet, m As Long If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 1 And Target.Column = 1 Then Set sh = ThisWorkbook.Worksheets(2) m = sh.Cells(31, 1).End(xlUp).Row + 1 If m >= 31 Or (m = 2 And sh.Range("A2").Value <> Empty) Then MsgBox "No More Fields", vbExclamation: Exit Sub x = Application.Match(Target.Offset(, 1).Value, sh.Columns(1), 0) If Not IsError(x) Then MsgBox "Customer Already Exists", vbExclamation: Exit Sub sh.Cells(m, 1).Value = Target.Offset(, 1).Value Target.Select End If End Sub

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

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

وعليكم السلام ورحمة الله وبركاته تفضل البحث عن طريق التيكست بوكس او الخليه e3 ثم تعبئه الليست بوكس بالاسماء ثم عند الضغط على اي سطر في الليست بوكس تنتقل البيانات الي الاماكن المطلوبه Private Sub TextBox1_Change() Test TextBox1 End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$E$3" Then Test Sheet2.Range("$E$3") End Sub Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ListBox1_Click End Sub Private Sub ListBox1_Click() Dim I As Long, M As Long, J As Long M = 0 For I = 0 To ListBox1.ListCount If ListBox1.Selected(I) = True Then For J = 5 To 10 Step 2 Sheet2.Cells(J, "D").Value = ListBox1.List(I, M) Sheet2.Cells(J, "G").Value = ListBox1.List(I, M + 3) M = M + 1 Next J End If Next I End Sub Sub Test(Search As Object) Dim A As Long, lrw As Long, C As Range ListBox1.Clear ListBox1.ColumnCount = 7 ListBox1.ColumnWidths = "60,0,0,0,0,0,1" lrw = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row For Each C In Sheet3.Range("a2:a" & lrw) If Search = "" Then GoTo 1 If C Like Search & "*" Then ListBox1.AddItem For I = 0 To 5 ListBox1.List(A, I) = Sheet3.Cells(C.Row, I + 1).Value Next I A = A + 1 End If Next C 1 End Sub

بالانتظار استاذي شكرا لك

مثل هذا الجهاز AT9000 ، ويعمل بنفس طريقة الجهاز CR100 بأته يأخذ كود MRZ ويفككه (وسيكون مشروعي التالي ان شاء الله 🙂 ) ، وبالاضافة يأخذ: صورة ملونة لصفحة الجواز ، صورة ابيض واسود لصفحة الجواز (لكشف التزوير) ، صورة من صورة صاحب الجواز الشخصية ، . . نعم يمكن التحكم في هذا ، بطريقتين: عن طريق ملف XML ، او بتفكيك السطر على اساس علامات "<" (لاحظ الوحدة النمطية في مشاركتي الأولى) ، او الاثنين معا 🙂 جعفر