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

وعليكم السلام 🙂 مشاركة مع اخوي @Foksh 🙂 هذا كود تفريغ حقل البحث، اذا كان النقر على زر البحث: Me.Txt_Search = "" او Me.Txt_Search = Null او Me.Txt_Search = Empty ثم Me.Txt_Search.Setfocus . اما اذا لم يوجد زر بحث، وكان الكود يعمل البحث على حدث "بعد التحديث" لحقل البحث ، فيجب ان ننقل التركيز على اي كائن في الموذج يقبل التركيز، ثم نستعمل الكود اعلاه ، هكذا مثلا: دائما في نماذجي عندي زر لغلق النموذج اسمه cmd_close فعليه يصبح الكود: me.cmd_close.setfocus Me.Txt_Search = "" او Me.Txt_Search = Null او Me.Txt_Search = Empty ثم Me.Txt_Search.Setfocus . جعفر

السلام عليكم 🙂 عملت على مشروع لمؤسسة خيرية فيه العديد من المستخدمين ، والعمل هو عبارة عن طباعة نحو 1000 كوبون خلال ساعة واحدة لوجبة غذاء مجانية ، وحوالي 600 كوبون خلال ساعة اخرى ، والكوبون يحتوي على شعار المؤسسة، وشعار آخر يتغير شبه كل يوم. الطرق المتبعة لعرض الصور في التقرير هي: قراءة الصور من مجلد المشاركة، ولكن قراءتها لكل كوبون، يجعل الشبكة مزدحمة بمرور الصور فيه، مما يعمل بطئ في الشبكة، نسخ الصور من مجلد المشاركة الى مجلد محلي على كمبيوتر المستخدم عند تشغيل البرنامج، ومن ثم قراءة الصور من المجلد المحلي عند طباعة كل كوبون، اما الطريقة الاسرع من الطريقتين اعلاه هي: عرض الصور من مجلد المشاركة عند تشغيل البرنامج، في النموذج الرئيسي للبرنامج في حقل الصور، عرض الصور في التقرير، بقراءة كل صورة من النموذج الرئيسي، هكذا لصورة واحدة: في التقرير، على حدث "عند التنسيق" في قسم Details التفصيل نضع هذا الكود Forms!frm_Main!myPic هو اسم حقل الصورة في النموذج الرئيسي pic هو اسم حقل الصورة في التقرير Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) Me.pic.PictureData = Forms!frm_Main!Mypic.PictureData End Sub جعفر

في البداية كان سؤالك هكذا !! وهذا ما عملت عليه... referenceNo يتغير حسب اسم المشروع ويبدأ بالعد من جديد في بداية السنة الجديدة

جرب هدا Sub PrintArea() Dim F As Worksheet: Set F = Sheet1 Cpt = 18: A = 1: B = 4: C = 1 With F .PageSetup.PrintArea = "" .PageSetup.PrintArea = Range("A1", Cells(46, Cpt)).Address: .PrintOut Copies:=A .PageSetup.PrintArea = Range("A47", Cells(96, Cpt)).Address: .PrintOut Copies:=B .PageSetup.PrintArea = Range("A97", Cells(150, Cpt)).Address: .PrintOut Copies:=C End With End Sub او يمكنك تحديد الصفحات وعدد مرات الطباعة بالاعتماد على ورقة اخرى خاصة بالاعدادات كما في المثال التالي Public Property Get Sh_Print() As Worksheet: Set Sh_Print = Sheet1 End Property Public Property Get F() As Worksheet: Set F = Sheet2 End Property Sub To_print() déleteRow TbPage = F.[Tb_MiseEnPage] NbMax = UBound(TbPage) Cpt = Application.InputBox(Prompt:=" المرجوا ادخال رقم الصفحة المرغوب طباعتها (من 0 الى " & NbMax & ")", Title:="طباعة", Type:=1) Cpt = Int(Cpt) If Cpt < 1 Then Exit Sub If Cpt > NbMax Then: MsgBox " اخر صفحة على الملف هي : " _ & NbMax _ & "", vbExclamation, "المرجوا التحقق من رقم الصفحة المرغوب طباعتها": Exit Sub With Sh_Print .PageSetup.PrintArea = "" For i = 1 To Cpt With .PageSetup On Error Resume Next .PrintArea = TbPage(i, 2) & ":" & TbPage(i, 3): Copies = TbPage(i, 4) If Copies < 1 Then Copies = 1 .FitToPagesWide = 1 .FitToPagesTall = 1 On Error GoTo 0 End With Next End With Sh_Print.PrintOut Copies:=Copies End Sub '*********************************** Sub déleteRow() With F For i = F.[B65000].End(xlUp).Row To 2 Step -1 Application.ScreenUpdating = False If Application.CountA(Range(F.Cells(i, "B"), F.Cells(i, "C"))) = 0 Then F.Rows(i).Delete F.Range("A2:A" & Rows.Count).ClearContents Next i With F.Range("A2:A" & F.Cells(Rows.Count, "B").End(xlUp).Row) .Value = Evaluate("ROW(" & .Address & ")-1") End With End With Application.ScreenUpdating = True End Sub نمودج طباعة.xlsm

تمام باش مهندس .. الآن هو يمكن فهم كل ما كتبته له اعلاه

السلام عليكم 🙂 هذا الرابط به برنامج مجاني (للإستعمال الشخصي) لإصلاح ملف اكسس معطوب / تالف جعفر

السلام عليكم ورحمة الله وبركاته أسعد الله أوقاتكم بكل خير وسرور .. وتقبل الله منا ومنكم صالحات الأعمال .. 😊🤲🏻 يطيب لي أن أقدم لكم هذا الهدية المتواضعة بمناسبة هذا الشهر الفضيل 🙂🌼🎁 استبدل الرسائل العادية في أكسس برسائل ذات تصاميم قمة في الإبداع وبمميزات إضافية . من مميزات هذه الرسائل: - تصميم جميل وألوان جذابة. - خاصية ذاتية الاختفاء. - عنوان رئيسي + عنوان فرعي - تحكم بالنص ( عربي - إنجليزي ) ( توسيط - محاذاة على اليمين أو اليسار) - سهلة الاستخدام . الشرح على اليوتيوب : التحميل 🙂 Moosak MsgBox.accdb ولا تنسوني من صالح دعواتكم 😊🌷🌼🌹

السلام عليكم ورحمة الله وبركاته هل ممكن استرجاع جدول في أكسس تم مسحه بالخطأ وتم اغلاق قاعدة البيانات بعده

ما الذي يميز الكتب الصادرة عن الكتب الواردة ؟؟

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

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

اخي عبداللطيف، شكرا لك على دعمك ومساعدتك للآخرين 🙂 وطبعا التزامك بقوانين المنتدى 🙂 قوانين المنتدى لا تسمح بإرفاق: اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة

اساتذتي بعد اذنكم لمسة بسيطة على مرفق أستاذنا @عبد اللطيف سلوم . test24-1.rar

الأولى لك أخي الكريم توضيح طلبك بشكل واضح أكثر ، ثم ارفاق مثالك الذي يحتوي بيانات على ما تريد التطبيق عليه

حتى تستفيد من الكود مباشرة كما هو بدون تعديل ( لان اضافة شروط قد تكون سببا في الزام ما لا يلزم ) هو ان تكون معرفات المشاريع بطول واحد .. كأن تضيف اصفار في بداية المعرف لان احد المعرفات عدده 9 بينما آخر اثنان

السلام عليكم لدي 3 نماذج FA ,FB ,FC في النموذج الفرعي FC يوجد كود Sub ccc() textboxc = 77 End Sub ماهي الطرقية التي يمكن مناداتة من النموذج الرئيسي FA والنموذج الفرعي FB عن طريق الازرار الموجودة في النموذجين وهل يوجد اكثر من طريقة لذلك CALLTEST.accdb

وعليكم السلام هكذا Call Form_FC.ccc بالتوفيق

اتذكر عند نقل قيمة من نموذج فرعي الى نموذج رأيسي كنا نستعمل الكود me.parant me.recalc لا اعرف اذا الموضوع ينجح مع متطلبات سؤالك

وعليكم السلام اخوي موسى 🙂 وعمل جميل آخر منك 🙂 جعفر

وعليكم السلام 🙂 طريقة ننتظرها من زمان، شكرا جزيلا لك 🙂 جعفر

اخي عبد اللطيف هل هذه النسخة مجانية وتعمل بدون تفعيل/كلمة سر ؟ جعفر

اهلا استاذ عبد اللطيف وكل سنة وانت طيب او وضع اي شي تريده محل القيمة الفارغة .. كما وضحت انت في الفيديو بارك الله فيك هي نفسها .. اقصد لاجديد يمكن ان تظهر النتيجة بدون استخدام الدالة فقط [الاسم]= ولكن الحركة الجميلة هي التعويض بدلا من وضع القيمة الافتراضية

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

المرجوا توضيح الطلب الاول او ارفاق عينة للنتائج المتوقعة اما بالنسبة للطلب الثاني يمكنك استخدام الكود التالي لجلب اسم الموظف Private Sub TextBox1_Change() ' اسماء الموظفين Dim iRow, clé, Myrng, j, r, name$ Set j = Sheets("اسماء الموظفين") Set iRow = j.Range("A2:B" & j.[A65000].End(xlUp).Row) LR = j.Cells(Rows.Count, 1).End(xlUp).Row Myrng = iRow.Value: name = Me.TextBox1.Value Set r = j.Range("A2:A" & LR).Find(name) On Error Resume Next If Not r Is Nothing Then For k = 1 To UBound(Myrng) If Myrng(k, 1) = name Then clé = k Me.réf = clé + iRow.Row - 1: Me.TextBox2 = Myrng(clé, 2) End If Next k Else Me.TextBox2 = Empty End If If Me.TextBox1 = "" Then Me.TextBox2 = "": Me.réf = "" End Sub عند كتابة الكود يأتي الاسم.xlsb

السلام عليكم جهودكم مشكورة ومقدرة عاليا اخي الكريم ننتظر انتهاء البرنامج ملاحظة..................... بالنسبة لقروب الواتس اب كيف استطيع الانضمام معكم 00962772623968

على فرض ان اسم مربع النص الخاص بالبحث Txt_Search : في حدث عند النقر اكتب هذا السطر Me.Txt_Search = "" Me.Txt_Search.Setfocus السطر الثاني لإعادة التركيز ( وضع المؤشر ) في مربع البحث.

مشاركة مع الاساتذة عملت جدول جديد تلافيا لعدم فهمي للجداول الموجودة ادخل اسم المشروع عن طريق الكومبوبوكس Memos.rar

الان قمت بتجربة الطريقة على قاعدة تحتوي 11700 سجل ومبنية بشكل متوافق مع متطلبات بناء قواعد البانات ولم اواجة اي مشكله

شكرا لك استاذا العزيز احاول اعمل شي على طريقتك واذا ما صار شي ننتظر الاساتذة

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

وملاحظة ،، تم تغيير اسم الحقل Date في الجدول الى Datee تلافياً لحدوث اي مشاكل أثناء كتابة الكود.

مشاركة جانبية ... تفضل اخي @Zooro1 Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim strProjectNo As String Dim strYear As String Dim strLastReferenceNo As String Dim intLastPart As Integer Dim intNewValue As Integer Dim strNewReferenceNo As String Set db = CurrentDb strProjectNo = Me.ProjectNo.Value strYear = Year(Me.Datee.Value) strSQL = "SELECT TOP 1 ReferenceNo " & _ "FROM ESMIncoming " & _ "WHERE ProjectNo = '" & strProjectNo & "' AND Year([Datee]) = " & strYear & " " & _ "ORDER BY Right([ReferenceNo], 4) DESC" Set rs = db.OpenRecordset(strSQL) If Not rs.EOF Then strLastReferenceNo = rs!ReferenceNo Else strLastReferenceNo = strProjectNo & "-" & strYear & "-0000" End If rs.Close intLastPart = CInt(Right(strLastReferenceNo, 4)) intNewValue = intLastPart + 1 strNewReferenceNo = strProjectNo & "-" & Format(Datee, "yy") & "-" & Format(intNewValue, "0000") Me.Text0.Value = "KNPC-" & strNewReferenceNo strSQL = "INSERT INTO ESMIncoming (ProjectNo, ReferenceNo, Datee) " & _ "VALUES ('" & strProjectNo & "', '" & strNewReferenceNo & "', #" & Format(Date, "mm/dd/yyyy") & "#)" db.Execute strSQL Set rs = Nothing Set db = Nothing Memos.accdb

كما تحب .. ستجد المبادرة من اخوتك هنا في النصح والتوجيه والتعليم ولكن اجعل منهجك انك من سيصيد السمكة ويشويها ثم يأكلها ولا تبحث عن سمكة جاهزة

بدون الحاجة لاكواد غير مصدر البيانات للتقرير الرئيسي الى استعلام يساوي SELECT معلومات_1.[اسم الاب], معلومات_1.[رقم الهاتف], معلومات_1.العنوان FROM معلومات, معلومات AS معلومات_1 INNER JOIN الابناء ON معلومات_1.[اسم الاب] = الابناء.[اسم الاب] GROUP BY معلومات_1.[اسم الاب], معلومات_1.[رقم الهاتف], معلومات_1.العنوان; الملف مرفق 1(2).accdb

تم إصدار التحديث الجديد من برنامج الحضور والإنصراف - التعديل الثالث ( الإصدار الثاني ) تم استبدال الباركود برمز QR لشموليته في البيانات ودعمه اللغة العربية بشكل جيد . ربط الجوال بالكمبيوتر مع إمكانية قراءة QR من الجوال عند قراءته في آكسيس . تم إدراج البرامج المستخدمة في الروابط للتجربة Barcode2WinSetup18 Exe / APK . بعد نسخ برنامج الـ APK الى الجوال وتثبيته . وتثبيت برنامج الكمبيوتر EXE ، نفتح البرنامج من الكمبيوتر ونطبق الإعدادات كما في الصورة :- بعد تطبيق الإعدادات ، افتح البرنامج من الجوال وقم بتصوير رمز الـ QR الموجود في البرنامج في الجزء 4 ، وسيتم الإتصال بالكمبيوتر بشكل سهل وسريع جداً ( شريطة أن يكون الجوال والكمبيوتر على نفس الشبكة المحلية للإنترنت ) الميزات التي تم تعديلها وإضافتها بشكل سريع :- إضافة فكرة اختيار التسجيل برقم الموظف أو اسم الموظف . إضافة نموذج لتسجيل المغادرات وطباعة إذن الخروج . ميزة المغادرة التي لا يمكن استخدامها إلا في تاريخها . بعض التنسيقات تم تعديلها وضبطها بشكل أفضل من الإصدار السابق . الملف ما زال قيد التطوير لذا سيكون في الوقت الحالي بنفس الصيغة ACCDE البرنامج المرفق APK تم التعديل عليه بحيث تقليل نسبة الخطأ في قراءة اللغة العربية في رمز الـ QR ، بالإضافة الى تعديل الأيقونة الخاصة به .. والمزيد ما زال قيد التعديل والتطوير .. بناءً على طلب أحد الإخوة في جروب الواتس أب سيتم إلحاق فيديو يوضح طريقة العمل على البرنامجين 😎

مشاركة مع الاساتذة ممكن نستخدم دالة العد Dim x As Integer x = DCount("*", "tbl_items", "[EmpID]=" & Me.y1.Column(1)) If x = 0 Then MsgBox "التقرير الفرعي لا يوجد به بيانات" Cancel = -1 Else DoCmd.OpenReport "Main_Report", acViewPreview End If اخونا الشايب

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

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

السلام عليكم عليك بتجزئة الملف لخطوات ..حتى يتم مساعدتك خطوة بخطوة

وعليكم السلام ورحمه الله وبركاته الكود ليس به مشكله اخى انما المشكله في ادخال البيانات تأكد من ان البيانات ليس بها خطأ #DIV/0! مثل هذه الصورة

جزاكم الله خيراً استاذنا الاستاذ حسونة وبارك الله لك وهذا تعديل أخر على الكود ايضاً ترحيل بالتاريخ بالكود.xlsb

تفضل استاذ @tiger wanted الكود والشرح . Private Sub Command0_Click() If IsNull(DLookup("Salary", "Table1")) Then MsgBox "أدخل المبيعات" End If End Sub

اشكر الجميع على المحاوله تم عمل المطلوب على طريقتى بدون تغيير المسميات ارفق الملف عسى ان يستفيد به الجميع 03.accdb