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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاتة اهلا بكم اعضاء المنتدى الكرام اعتذر جدا للغياب الطويل عن المنتدى ولكن اشتقت اليكم فقولت ارجع بكود ممكن يفيد البعض فى عملة يعتبر البحث عن البيانات من الامور التى يبحث عنها كل مستخدمى الاكسل حيث انها تسهل عليهم اعمالهم وتحليل البيانات لديهم ولكن اذا كان لديك بيانات كثيرة جدا فى شيت الاكسل فالامر هنا يكون شاق ومرهق ومن هنا قررنا انشاء كود بحث من خلال اليوزرفورم يقوم بالبحث عن البيانات وتلوين واظهار نتائج البحث يتم وضع الكود فى حدث التكست بوكس Dim Itemsaerch As String Dim rng As Range Dim cell As Range Dim lr As Long Sheet1.Cells.Interior.Pattern = xlNone Itemsaerch = Me.TextBox1.Value lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Set rng = Sheet1.Range("a2:a" & lr) For Each cell In rng If InStr(1, cell.Value, Itemsaerch) > 0 Then cell.Interior.Color = vbGreen End If Next cell If Me.TextBox1.Value = "" Then Sheet1.Cells.Interior.Pattern = xlNone ملف العمل فورم بحث جديد وتلوين نتائج البحث.xlsm

فى ظل امكاناتي المتواضعه وللحاجه وبعد مراجعة العديد من الحلول المتوفره على الويب التى لم اجد بها ضالتي اقدم لكم مربع التلوين هذا colorpicker حيث يقوم بتلوين خلفية النموذج بشرط تسميتها detail بالانجليزيه ورأس النموذج بشرط تسميته header وتذييل النموذج بشرط تسميته footer وكذلك مربعات التنسيق والتجميل rectangle بشرط ان يتم تسميتها box1 , box2 وهكذا وضعت وظائف التلوين فى حدث عند النقر المزدوج فى كل منها طبعا يمكن استخدام اسماء عناصر عربيه لكنها ستحتاج تعديل فى الجدول والكود ولا افضل ذلك المربعات الونيه يمكن تلوين حتى box9 اى تسع مربعات النموذج يحتوي اكثر من 400 لون معد سلفا منها 160 لون عشوائي تتغير بضغطة زر الى اخرى كل لون تختاره يمكنك التعديل عليه بتغيير قيم الالوان الاحمر والاخضر والازرق يوجد جزء خاص لضبط الخطوة فى + او - بقيم من 1 حتى 25 كما يوجد جزء خاص بتحديد سلوك تلوين الفورم فى المره القادمه التى سيفتح فيها وامامك 3 خيارات اما استخدام خياراتك الاخيرة للالوان واما استخدام الوان الجدول الافتراضيه وهى الوان رماديه يمكن تغييرها من الجدول فقط واما استعادة الوان الفورم عندما تم تصميمه ويتم التحكم فى كل جزء على حده اعلم انه بدائي لكنه يؤدي الغرض بفاعليه ونرحب بالافكار الجديده الكود متاح للجميع استخدامه شخصيا او تجاريا بشرط عدم ازاله شعار مؤسسة وعد الخيريه او كود الصوره اتمنى تزويدي بتعليقاتكم البرمجيه لتحسي الكود وتطويره لتعيين الصور كخلفيات يمكن التحميل من هنا mycolorpiker.zip

وعليكم السلام 🙂 مشاركة مع اخوي @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 . جعفر

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) كنت قد بحثت في المنتدى 🔍 (هنا) عن برامج لعرض مواقيت الصلاة ، وقد وجدت الكثير من المواضيع الجميلة والأفكار النيرة في المنتدى لأساتذة وأخوة بذلوا جهداً لا يوصف في مشاركاتهم بهذا الموضوع ، وإلى حد ما أكثرهم قرباً لضبط الأوقات كانت هذه المشاركة . اليوم الفكرة مختلفة قليلاً في هذا المشروع المتواضع والذي لا يحتوي تعقيدات يصعب قراءتها أو التعامل معها في الأكواد . حيث اعتمدت وتوجهت إلى البساطة من حيث عند النقل والدمج ( إلى / في ) أي مشروع . الآن شرح بسيط لبعض تفاصيل المشروع التي سيتم الإعتماد عليها :- سي سيتم الإعتماد على خطوط الطول والعرض بعد إجراء بعض التعديلات على طريقة احتساب الأوقات . وقد تمت المقارنة مع موقع ( مواقيت الصلاة ) للوصول إلى أقل فارق - إن وُجِد - في المواقيت . سيتم الإعتماد على تقويم أم القرى في أحدى مشاركات أستاذنا @ابوخليل . سيتم اعتماد إظهار الوقت المتبقي لكل موعد صلاة في الشاشة الرئيسية أو المصغرة ( ستضاف لاحقاً ) . سيتم منح الحرية للمستخدم بنوع التذكير لوقت الصلاة ( إشعار برسالة تنبيه داخل البرنامج ، إشعار فوق شريط Taskbar ) . سيتم أيضاً منح الحرية للمستخدم باختيار صوت التنبيه ( أذان كامل ، تكبير ، .... إلخ ) . المزيد من الأمور ستأتي لاحقاً تباعاً في تطويرات وتحديثات جديدة إن شاء الله . صورة لواجهة البرنامج حالياً ، والذي أسميته في الوقت الحالي " صلوات " 🤗 ، ما لم يتم اختيار اسم آخر

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

السلام عليكم 🙂 عملت على مشروع لمؤسسة خيرية فيه العديد من المستخدمين ، والعمل هو عبارة عن طباعة نحو 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 جعفر

على قددر علمي اقدم لكم هذه الهدية للتحكم فى خيارات العرض والتشغيل كما هو موضح فى الصورة المرفقة اضفت نموذج ارضية وشريط ادوات عائم يمكنتك تطويره يلاحظ ان خاصية autocompact معطلة فى كلا الحالتين يمكنك تفعيلها تقبلوها منى خالصة لوجه الله تعالى وارجوا امدادى بخصائص اخرى حبث انى حديث عهد باكسس ولا تنسوا التقييم والرأي ولفت نظرى لاى خطأ كلمة السر 123 يمكنك تعديلها dboptions.rar

السلام عليكم مع خالص التقدير لأخونا أبو أحمد هذا حل آخر بلا أكواد فقط بالمعادلات فصل الارقام عن الاحرف.xlsx

بسم الله الرحمن الرحيم السلام عليكم ورحمه الله وبركاته طبعا انا مسجل من فترة طويلة والصراحة منتدى مبدع واستفدت كثير وطرق كثيرة و استاذة كبار المنتدى حبيت اشارك بهذا الموضوع البسيط والكثير يبحث عنة وإن شاء الله اكون عند حسن الظن اخفاء الجداول و اظهارها على زر اظهار و اخفاء بكل بساطة ووضعت لكم الاكواد مع شرحها زر اخفاء الجداول اسم الزر ( HideTables ) كود الزر Dim db As DAO.Database Dim tbl As DAO.TableDef Set db = CurrentDb ' قم بتحديد الجداول التي ترغب في إخفائها ' يمكنك تكرار هذا السطر لإضافة المزيد من الجداول Set tbl = db.TableDefs("اسم_الجدول") ' قم بتعيين خاصية Hidden للجدول إلى True لإخفائه tbl.Attributes = dbHiddenObject ' أغلق قاعدة البيانات db.Close Set tbl = Nothing Set db = Nothing كود زر اظهار الجداول اسم الزر ( ShowTables ) Dim db As DAO.Database Dim tbl As DAO.TableDef Set db = CurrentDb ' قم بتحديد الجداول التي ترغب في إظهارها ' يمكنك تكرار هذا السطر لإضافة المزيد من الجداول Set tbl = db.TableDefs("اسم_الجدول") ' قم بتعيين خاصية Hidden للجدول إلى False لإظهاره tbl.Attributes = tbl.Attributes And Not dbHiddenObject ' أغلق قاعدة البيانات db.Close Set tbl = Nothing Set db = Nothing ودمتم سالمين باحطاب سوفت

تفضل مسار المجلد.rar مسار الملف.rar

اقدم لكم برنامج تحفيظ اسماء الله الحسنى للكبار والصغار مفتوح المصدر. . اليكم لينك المرفق . https://www.mediafire.com/file/1hrvf0h938769yq/GodNames.v1.1.rar/file

اقدم لكم برنامج مطعم كلاسيكي مفتوح المصدر. به بعض الكودات من أعمال بعض المنتسبين بمنتدانا (أفسينا)..... (به 33 طاولة طعام + دليفري + تيك أواي) ....والمهتم سيكتشف مابه ....... وأي استفسار أنا حاضر . اليكم لينك المرفق . https://www.mediafire.com/file/j0qasl6mlv1ju3x/CoffeShop.rar/file

وعليكم السلام ورحمة الله اخي محمد عمل رائع ومتميز وغير مستغرب من استاذنا الفاضل @ابو جودي الذي تعلمنا ومازلنا نتعلم منه الكثير 🌹 بالنسبة للاخ شايب يفضل استخدام نظام صلاحيات محكم وبالتالي فلا حاجة لكلمة مرور لفتح نموذج او طباعة تقرير الامر الاخر ان وضع كلمة مرور بشكل مباشر في محرر الاكواد يتطلب الدخول لوضع التصميم عند الرغبة في تغييرها وهو مالا يمكن تحقيقه عند تحويل القاعدة الى ACCDE اضافة الى ان كتابة كلمة المرور في محرر الاكواد يجعل امكانية معرفتها اكثر سهولة حتى لو تم تحويل القاعدة الى ACCDE انظر هنا ⬇️ مداخلات اخونا الشايب تمثل رأي غير ملزم وليس الهدف منها انتقاد عمل الاخرين لذا نقول لمن يمر خذ او اترك

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

السلام عليكم ورحمة الله تعالى وبركاته وانا فايت لاقيت استاذنا الجليل اخوانا @شايب قلت فى نفسى لا لابد من المرور والقاء السلام ومشاركة مع احبائى فى الله اليكم فكرة بدون دوال وهى الاحب الى قلبى الشرح 1- انشاء وحدة نمطية عامة وظيفتها الاعلان عن متغيرات عامة وهى كالاتى Public strPasswordPrompt As String Public boolPasswordPrompt As Boolean 2- ننشئ نموذج لكلمة السر على ان يكون اسمه frmPasswordPrompt وبه مربع النص لكتابة كلمة السر على ان يكون اسمه txtPassword زر امر التأكيد على ان يكون اسمه btnConfirmation ونضع الكود الاتى لزر الامر boolPasswordPrompt = True strPasswordPrompt = Nz(Me.txtPassword.Value) DoCmd.Close acForm, Me.Name وهنا نطلب منه انه يلحق القيمة True الى المتغير العام boolPasswordPrompt وان يلحق القيمة التى سوف يتم كتابتها فى مربع النص txtPassword الى المتغير العام strPasswordPrompt ثم يغلق النموذج زر امر الالغاء على ان يكون اسمه btnCancel ونضع الكود الاتى لزر الامر boolPasswordPrompt = False DoCmd.Close acForm, Me.Name وهنا نطلب منه انه يلحق القيمة False الى المتغير العام boolPasswordPrompt ثم يغلق النموذج الان يمكن استخدام كلمة سر فى اى مكان فى النموذج اما للحذف او للطباعة او لفتح نموذج حسب رغبة المصمم والان الية استدعاء هذا النموذج للعمل على زر الامر المراد قتح النموذج السرى من خلاله نضع الاكواد الاتية Const CORRECT_PASSWORD As String = "123" Const MSG_ENTER_PASSWORD As String = "Please enter a password to proceed." Const MSG_INCORRECT_PASSWORD As String = "Incorrect password. Operation canceled." Const MSG_PROCEED_SUCCESSFULLY As String = "proceed successfully!" Const MSG_OPERATION_CANCELED As String = "Operation canceled" Do DoCmd.OpenForm "frmPasswordPrompt", , , , , acDialog Select Case True Case boolPasswordPrompt Select Case True Case Nz(strPasswordPrompt, "") = "" MsgBox MSG_ENTER_PASSWORD, vbExclamation Case strPasswordPrompt <> CORRECT_PASSWORD MsgBox MSG_INCORRECT_PASSWORD, vbExclamation Case Else MsgBox MSG_PROCEED_SUCCESSFULLY DoCmd.OpenForm ChrW("1587") & ChrW("1585") & ChrW("1610") Exit Do End Select Case Else MsgBox MSG_OPERATION_CANCELED, vbExclamation Exit Do End Select Loop هذا شرح مبسط للفكرة العامة ولكن ان اردنا العمل اكثر احترافية ومرونة من خلال الاكواد فى وحدة نمطية انظر المرفق الاتى رقم سري.accdb

السلام عليكم ورحمة الله وبركاته بريمج صغير لتقييم اداء الموظفين تم الاقتباس والاستفادة من برنامج استاذنا القدير خليفة .. من هنا لمن اراد الزيادة حرصت على اختصار الكائنات قدر الامكان ليسهل ادراجه ضمن برنامجك اخي الحبيب البرنامج عبارة عن نموذجين وتقرير واحد فقط النموذج الاول : للاطلاع على بنود التقييم مع امكانية الاضافة او الحذف النموذج الثاني : لعملية التقييم والحفظ وعرض التقرير والطباعة مع بعض الضوابط منها مثلا منع تكرار التقييم في السنة الواحدة للموظف اتمنى ان تجدوا فيه الفائدة والمتعة EvaluationEmployees.rar

مشاركةً مع اساتذتي تفضل استاذ @salah.sarea محاولتي . 1- ضغط واصلاح القاعدة الخلفية للقاعدة الحالية (القاعدة الخلفية محمية بكلمة مرور) . 2- ضغط واصلاح اي قاعدة تختارها (القاعدة محمية بكلمة مرور) . 3- ضغط واصلاح اي قاعدة تختارها (القاعدة غير محمية ) . ووافني بالرد . compact and repair.rar

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

بكل سرور اخي @Alaa Ammar New يسعدنا اننا استطعنا مساعدتك

السلام عليكم ورحمه الله وبركاته وبها نبدأ تفضل اخى باسسورد الدخول 123 نظام الحسامي للمخازن-123.xlsb

لم تدكر اخي ما هو النطاق المطلوب تفضل جرب هل هدا ما تقصده Sub CopySheet() Dim filePath$, folderName$, Fname$ Dim rCopy As Range, rng As Range Dim lRow As Long, i As Integer Dim wbSource As Workbook Set wbSource = ThisWorkbook Set WS = wbSource.Worksheets("Sheet1") lRow = WS.Range("B" & WS.Rows.Count).End(xlUp).Row Set rCopy = WS.Range("A7:K" & lRow).SpecialCells(xlCellTypeVisible) folderName = "ملفات Excel" Fname = "تقرير النشاط" filePath = ThisWorkbook.path & "\" & folderName On Error Resume Next 'OR 'filePath = "D:" & "\" & folderName If WS.Range("L9:L" & lRow).SpecialCells(xlCellTypeVisible).Count > 1 Then With Application .ScreenUpdating = False .DisplayAlerts = False .CopyObjectsWithCells = False Set newWb = Workbooks.Add: Set SH = newWb.Sheets(1) rCopy.Copy Destination:=SH.Range("A3") LastR = SH.Range("A" & SH.Rows.Count).End(xlUp).Row SH.Range("A7:A" & LastR).RowHeight = 28 For i = 1 To 11 Columns(i).ColumnWidth = WS.Columns(i).ColumnWidth Next i SH.[A5] = 1: SH.Range("A5:A" & SH.Cells(Rows.Count, 2).End(3).Row).DataSeries , xlLinear 'Columns(1).Delete If Dir(filePath, vbDirectory) = "" Then MkDir filePath newWb.SaveAs fileName:=filePath & "\" & Fname & ".xlsx", FileFormat:=51 newWb.Close .CopyObjectsWithCells = True .DisplayAlerts = True .ScreenUpdating = True End With sMsg = "Excel" & " " & "تم حفظ التقرير بنجاح في مجلد " & "ملفات" MsgBox sMsg, vbExclamation, " من تاريخ: " & " " & WS.[D4] & " " & "إلى تاريخ:" & " " & WS.[F4] Else MsgBox "لا توجد بيانات للحفظ", vbInformation, "تم إلغاء الإجراء" End If End Sub فلترة وحفظ.xlsm

وعليكم السلام ورحمة الله وبركاته اخي @salah.sarea . ضع هذا الكود في حدث عند النقر لزر الإصلاح ، مع تحديد مسار قاعدة البيانات B_Be حسب ما تريد . Private Sub btnRepair_Click() Dim strConnect As String Dim strPassword As String strPassword = "123" strConnect = "MS Access;PWD=" & strPassword & ";DATABASE=path_to_b_be.accdb" Application.CompactRepair SourceFile:="path_to_b_be.accdb", DestinationFile:="path_to_b_be.accdb", _ Password:=strPassword MsgBox "تم إصلاح قاعدة البيانات بنجاح!", vbInformation End Sub طبعا على افتراض أن اسم الزر btnRepair.

جرب هدا Private Sub TextBox1_Change() Set WS = Sheets("Sheet1") On Error Resume Next If WS.TextBox1.Text = Empty Then WS.[A8:L8].AutoFilter lr = WS.Cells(WS.Rows.Count, "L").End(xlUp).Row Clé = "*" & Replace(WS.TextBox1.Text, " ", "*") & "*" If WS.TextBox1.Text <> "" Then Set rng = WS.Range("A8:L" & lr) '****المفتاح***** rng.AutoFilter field:=12, Criteria1:=Clé '******* اظافة شرط بين تاريخين rng.AutoFilter field:=3, _ Criteria1:=">=" & CDbl(WS.[D4]), Operator:=xlAnd, _ Criteria2:="<=" & CDbl(WS.[F4]) Else WS.[A8:L8].AutoFilter End If End Sub Sub test() Dim desWS As Worksheet: Set desWS = Sheets("Sheet1") Dim dest As Worksheet: Set dest = printing Application.ScreenUpdating = False If Sheets("Sheet1").TextBox1.Text = "" Then Exit Sub rng = Application.WorksheetFunction.Subtotal(3, desWS.Range("L9:L10000")) If rng = 0 Then: MsgBox "لا توجد بيانات للحفظ", vbInformation, "تم إلغاء الإجراء": Exit Sub Set a = desWS.Range("A8", desWS.Range("A" & desWS.Rows.Count).End(xlUp)) ' For r = 1 To 11 لغاية عمود الملاحظات For r = 1 To 12 'مفتاح ' لغاية عمود Set a = Union(a, Intersect(a.EntireRow, a.Columns(r))) Next r Msg = MsgBox("؟" & " " & "PDF " & ":" & " تصدير التقرير بصيغة", vbYesNo, dest.Name) If Msg <> vbYes Then Exit Sub dest.Range("A3:L" & dest.Rows.Count).Clear a.Copy Destination:=dest.Range("A6") 'حفظ PDF Save_As_PDF2 On Error Resume Next desWS.AutoFilter = False Sheets("Sheet1").TextBox1.Text = "" Application.ScreenUpdating = True End Sub فلترة وحفظ PDF +EXCEL V2.xlsm

السلام عليكم ورحمة الله وبركاته هذه محاولة في الملف المرفق إن كنت قد وُفقت في فهم المطلوب... جرد المخزن_1.xlsx

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) لكثرة الطلبات على برنامج إدارة الحضور والإنصراف للموظفين ، وددت مشاركتكم النسخة الأولى الغير مفتوحة المصدر حالياً ، لحين الإنتهاء من التعديلات التي ستتم على البرنامج . دون الإطالة في المقدمة ؛ سأشرح لكم بعض ميزات البرنامج :- أولاً سيتم إضافة الإعدادات الضرورية للبرنامج وهي :- تصنيف الموظفين ( ولكل تصنيف سيتم تحديد عدد أيام الإجازات السنوية له ) . تصنيف الإجازات ( طارئة ، مرضية ، ..... إلخ ) . تحديد وقت بداية ونهاية ساعات العمل الرسمي ، و تحديد مدة السماح للتأخير ( المرونة في العمل ) ، تحديد عدد مرات التأخير ليتم احتساب يوم إجازة في اليوم الأخير من المدة . ثانياً ومن الطبيعي وجود موظفين في قاعدة البيانات ، سيكون قسم لإدخال بيانات الموظفين بشكل بسيط من المعلومات ( ولكم حرية التوسع حسب رغبتكم وحاجتكم كمستخدمين ) ، وطبعاً لكل موظف رقم وظيفي خاص به اعتمد على سلسلة مكونة من التاريخ والوقت الحالي بدون مسافات بهذا التنسيق YYYYMMDDhhmmss ، بحيث لا يكون هناك تكرار نهائي لأي رقم موظف . ثالثاً لوحة تسجيل الحضور والإنصراف عن طريق الرقم الوظيفي ، وتدعم القراءة من الباركود الموجود على باجة الموظف ( طبعاً لاحقاً سيتم إضافة طباعة باجة أو بطاقة للموظف ) ، وفي هذه اللوحة لن تحتاج تحديد الحالة ( حضور أو إنصراف ) فقط أدخل رقم الموظف وسيتم احتساب وقت الحضور وتسجيل مدة التأخير بالدقيقة في الجدول ، وكذلك الأمر للإنصراف . رابعاً لوحة تسجيل الإجازات ، وطبعاً بناءً على المعطيات التي تم إدخالها في نماذج البيانات الأساسية في الإعدادات - سيكون الأمر بسيطاً جداً وتم اعتماد رقم الموظف في المرحلة الأولى من البرنامج وسيتم اعتماد اسم الموظف أيضاً لجلب البيانات لاحقاً . بخطوات بسيطة بعد ادخال رقم الموظف نحدد تاريخ بداية الإجازة ، ثم عدد الأيام المطلوبة كإجازة ، ثم سيتم تلقائياً احتساب يوم نهاية الإجازة ، وطبعاً نوع الإجازة المطلوبة ستقوم باختياره من قائمة نوع الإجازة . خامساً لوحة التقارير ، بحيث سيكون لدينا في المشروع تقرير واحد فقط لكنه سيخدم جميع الطرق التي تريدها كمستخدم ( تقرير للموظفين جميعاً مع وبدون تحديد فترة ، تقرير لموظف واحد مع وبدون تحديد فترة ) . *وطبعاً ما زالت قيد التطوير بشكل خاص ملاحظة:- تم حفظ البرنامج بصيغة Accde كونه قيد التطوير والتعديل حالياً اقترب عيد المسلمين مودعين به شهرهم الفضيل أعاده الله علينا وعليكم باليمن والبركات . وتقبل الله منا ومنكم الطاعات وصالح الأعمال . وسأختم به آخر تعديل على هذا المشروع البسيط ؛ متمنياً أن يكون على قدر الجهد المبذول فيه . وأعتذر بداية عن التأخير في انهاء العمل عليه ، ولكن لضيق الوقت ليس إلا . اليوم انهيت تأسيس الأساسيات في برنامج إدارة الحضور والإنصراف الذي يعمل بنظام بصمة الـ QR . وسأذكر بالتفصيل البسيط ما تم إضافته . الإضافات في النماذج :- ربط قارىء QR يعمل عن طريق الـ USB أو عن طريق الجوال بالنظام . دعم كامل لللغة العربية في قراءة رمز الإستجابة السريعة QR . اعتماد اسم الموظف بالإضافة الى رمز الـ QR . نظام التنبيه لضبط الإعدادات الرئيسية في البرنامج عند تشغيله أول مرة . إحصاء لعدد الموظفين ، الحضور ( على رأس عملهم ) ، المجازين ، المغادرات خلال اليوم . ترحيل بيانات الإجازات والمغادرات والحضور بشكل شهري ( بداية كل شهر ) . الإضافات في الأكواد :- تمت مراجعة جميع الأكواد من أي خطأ محتمل في التنظيم أو آلية العمل . تم إضافة فكرة تثبيت برنامج الربط Barcode2Win من خلال الأكواد ، وفي حال عدم وجوده يتم تحميله من الموقع الرسمي ( يتطلب انترنت ) . تم دمج العديد من الإستعلامات في الأكواد لتقليل مكونات وعناصر النظام وتخفيف العبئ عليه . تم تقسيم العديد من الوظائف لسهولة التعامل معها وصيانتها . تم إضافة نموذج لإعادة تهيئة النظام وتفريغ محتوياته ( الجداول ) ، طبعاً باسوورد تأكيد العملية مدمج في أكواد النموذج . العديد من المميزات التي ستجدونها في المشروع

السلام عليكم ورحمة الله تعالى وبركاته بعد ادن الاستاد @عبدالله بشير عبدالله اليك حل اخر ربما يناسبك هدا الكود لفلترة البيانات بين التواريخ ونسخها لورقة مخفية على نفس المصنف باسم printing Sub FilterByDate() Dim WS As Worksheet: Set WS = Worksheets("Sheet1") Dim desWS As Worksheet: Set desWS = Sheets("الانشطة") Dim f As Worksheet: Set f = printing Dim MinDate As Date, MaxDate As Date, lr As Long Dim a As Range, r As Long MinDate = desWS.[d2]: MaxDate = desWS.[f2] Application.ScreenUpdating = False If MinDate > MaxDate Then: Exit Sub If Len(desWS.[f2]) > 0 And IsDate(desWS.[d2]) Then If WS.AutoFilterMode Then WS.AutoFilterMode = False With WS.Range("A7:K7") .AutoFilter 3, ">=" & CLng(MinDate), 1, "<=" & CLng(MaxDate) lr = WS.Columns("A:K").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row Set rng = WS.Range("A" & lr & ":k" & lr).SpecialCells(xlCellTypeVisible) If WorksheetFunction.Subtotal(3, WS.Columns(3)) > 1 Then desWS.Range("A5:K" & Rows.Count).Clear With rng Cpt = Split("A,B,C,D,E,F,G,H,I,J,k", ",") Col = Split("A,B,C,D,E,F,G,H,I,J,k", ",") For i = LBound(Cpt) To UBound(Cpt) WS.Range(Cpt(i) & "8:" & Cpt(i) & lr).Copy desWS.Range(Col(i) & "5") Next i End With lige = desWS.Range("A:J").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row Cpt1 = "=IF(c5="""","""",IF(c5=""Name"",""Count"",N(b4)+1))" Cpt2 = "=IF(ISBLANK(b5),"""",SUBTOTAL(3,B$5:B5))" With desWS .Range("B5:B" & lige).Formula = Cpt1: .Range("A5:A" & lige).Formula = Cpt2 .Range("A5:B" & lige).Value = .Range("A5:B" & lige).Value End With End If .AutoFilter End With f.Range("A2:K" & f.Rows.Count).Clear Set a = desWS.Range("A4", desWS.Range("A" & desWS.Rows.Count).End(xlUp)) For r = 1 To 11 Set a = Union(a, Intersect(a.EntireRow, Columns(r))) Next r a.Copy Destination:=f.Range("a2") End If Application.ScreenUpdating = True End Sub لحفظ الملف بصيغة PDF Sub Save_folder_PDF() Dim sFile As String, sPath As String, fPath As String Dim sMsg As String Dim desWS As Worksheet: Set desWS = Sheets("الانشطة") Dim f As Worksheet: Set f = printing sFile = "تقرير النشاط" folderName = "ملفات PDF" Application.ScreenUpdating = False Msg = MsgBox("؟" & " " & "PDF " & ":" & " تصدير التقرير بصيغة", vbYesNo, f.Name) If Msg <> vbYes Then Exit Sub f.Visible = xlSheetVisible With ActiveWorkbook sPath = .path & Application.PathSeparator & folderName & Application.PathSeparator On Error Resume Next If Len(Dir(sPath, vbDirectory)) = 0 Then End If MkDir sPath f.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1 f.ExportAsFixedFormat Type:=xlTypePDF, _ FileName:=sPath & Application.PathSeparator & sFile & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False f.Visible = xlSheetVeryHidden End With sMsg = "PDF" & " " & "تم حفظ التقرير بنجاح في مجلد " & "ملفات" MsgBox sMsg, vbExclamation, " من تاريخ: " & " " & desWS.[d2] & " " & "إلى تاريخ:" & " " & desWS.[f2] Application.ScreenUpdating = True End Sub لحفظ التقرير في ملف مستقل Sub Save_folder_Excel() Dim WS As Worksheet: Set WS = printing Dim desWS As Worksheet: Set desWS = Sheets("الانشطة") Dim path As String, folderName As String, sMsg As String Dim newWb As Workbook, Fname As String path = ThisWorkbook.path & "\" On Error Resume Next Msg = MsgBox("؟" & " " & "Excel " & ":" & " تصدير التقرير بصيغة", vbYesNo, WS.Name) If Msg <> vbYes Then Exit Sub With Application .ScreenUpdating = False .DisplayAlerts = False WS.Visible = xlSheetVisible folderName = "ملفات Excel" MkDir path & folderName Fname = folderName & "\" & WS.Name WS.Copy Set newWb = ActiveWorkbook newWb.SaveAs FileName:=path & Fname & ".xlsx", FileFormat:=51 newWb.Close WS.Visible = xlSheetVeryHidden .DisplayAlerts = True .ScreenUpdating = True End With On Error GoTo 0 sMsg = "Excel" & " " & "تم حفظ التقرير بنجاح في مجلد " & "ملفات" MsgBox sMsg, vbExclamation, " من تاريخ: " & " " & desWS.[d2] & " " & "إلى تاريخ:" & " " & desWS.[f2] End Sub فلترة وحفظ PDF +EXCEL.xlsm

أولا : لمعرفة العناصر المرتبطة بأي جدول أو استعلام ( النماذج والتقارير التي تم استخدام هذا الجدول فيها ) .. اتبع الخطوات التالية : بعدها ستظهر لك جميع النماذج أو التقارير التي تستخدم هذا الجدول أو الاستعلام .. كرر هذه الخطوات لمعرفة العناصر المرتبطة بالجداول الأخرى .. 🙂 ثانيا : لتحليل أداء قاعدة البيانات لديك .. اتبع الخطوات التالية (ختر جميع العناصر الجداول والاستعلامات والنماذج والتقارير وووو....) : بعدها ستحصل على تقرير ونصائح للكائنات المذكورة في القائمة لتحسين الأداء 🙂

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

وعليكم السلام اخوب محمد واهلا وسهلا بك في المنتدى ، وللاستفادة القصوى من المنتدى ، برجى قراءة قوانين المنتدى : اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف اما الرد على طلبك ، فهل هناك طريقة لتمييز السجل عن الآخر الذي به طريقة البيانات التي تريدها؟ بمعنى: هل هناك تسلسل معين في السجلات ، وانت دائما تريد السجل الاول والرابع ، وهل الفرز دائما يكون كما اوضحت في الصورة؟ وفي مثل طلبك ، ياريت ترفق بيانات من قاعدة بياناتك ، حتى تكون الصورة واضحة 100% وحينها لن يقصروا الشباب في الرد ان شاء الله 🙂 جعفر

ومشاركة مع الأخوة والأساتذة:- Private Sub StudentName_BeforeUpdate(Cancel As Integer) If DCount("*", "Student_Tbl", "StudentName = '" & Me.StudentName & "'") > 0 Then MsgBox "اسم الطالب موجود بالفعل في الجدول.", vbExclamation, "تكرار الاسم" Cancel = True End If End Sub

مشاركة مع استاذي @عبد اللطيف سلوم تفضل استاذ @طير البحر محاولتي حسب مافهمت .اليك الشرح والمرفق . 1- مسار الصفحة بالفورم Forms!frm_Tab!TabCtl0.Value = 4 ' frm_Tab = اسم الفورم ' TabCtl0 =اسم التاب كنترول حيث 4= رقم الصفحة' 5 2- كيفية فتح الفورم على تاب محدد وليكن page5 (سويت لك 3 نماذج ) للتوضيح . DDTabcontrolPages.rar

اقدم لكم برنامج حساب أيام العمل أو الاجازات بين تاريخين .......... (اختيار أيام العمل الاسبوعية + العطل الرسمية) مفتوح المصدر. . اليكم المرفق . DDDayWork.rar

تفضل أخي @salah.sarea ، هذا الكود لإضافة كلمة تحددها في النموذج الى جميع السجلات في الجدول الذي تختاره ، طبعاً باستثناء حقل الترقيم التلقائي :- Sub AddWordToAllFields() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strSQL As String Dim strTable As String Dim strWordToAdd As String Dim fld As DAO.Field strTable = Txt_Tbl.Value strWordToAdd = Txt_Search.Value Set db = CurrentDb Set rs = db.OpenRecordset(strTable) For Each fld In rs.Fields If fld.Name <> "ID" And fld.Name <> "RecordID" Then strSQL = "UPDATE " & strTable & " SET " & fld.Name & " = IIf([" & fld.Name & "] Is Null, '" & " " & strWordToAdd & " " & "', [" & fld.Name & "] & '" & strWordToAdd & "')" db.Execute strSQL End If Next fld rs.Close Set rs = Nothing Set db = Nothing MsgBox "تمت إضافة الكلمة بنجاح إلى جميع الحقول في الجدول" End Sub Add_Word.accdb

في البداية كان سؤالك هكذا !! وهذا ما عملت عليه... 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

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

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

من منتدى قسم الاكسيل نحيكم🤗 وندعو الله لكم ان يجعلها في ميزان حسناتكم يوم القيامه هنحتاج نسخه ٦٤ بت كمان علشان السرعه تكون عاليه شويه

فكرة حسب تصوري الافضل تستبعد فكرة المربعات عند تصميمك لأن الطاولة عبارة عن رقم يدل على صاحب الطلب صورة العمليات تتم كالتالي : المطاعم الكلاسيكية العادية : النادل طلب من المحاسب تسجيل عصير للطاولة 1 ... المحاسب ادخل المعلومة وطبع فاتورة بالمطلوب مع رقم الطاولة الى معد الوجبات النادل اخذ الطلب من المعد واوصله الى طاولة واحد ........................ طلب اضافي من طاولة 1 ... 2شاي يذهب النادل الى المحاسب ( وتتكرر العملية ) ................... عند الانتهاء ياخذ النادل الفاتورة النهائية (فاتورة العميل ) ................................................................................................................ المطاعم السريعة : والتي تتيح الاكل داخل المطعم هذه يمكن ان تعمل المربعات لأن الدفع مقدم والطاولة يختارها الكاشير بناء على المتاح ...................... ومؤكد ستجد افكارا اخرى من الأجبة الزملاء

يا هلا استاذ قاسم وكل عام وانتم بخير وسوف احمل المرفق يا هلا استاذنا وكل عام وانتم بخير الحقيقة ان الاولى يعدها اكسس 0 اما البقية فلا يعدها اكسس ونحتاج عند عد احرف الحقل الى استخدام nz حتى لا نحصل على رسالة خطأ الحقيقة ان ⬇️ مجرد تفكير بصوت مرتفع ومع ذلك اعتز بمداخلتكما اخونا الشايب

استاذ @محمد سعيد رشاد اذا كان طلبك مهم ارسل القاعدة . لدي البرنامج مفعل .

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

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

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

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

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

تفضل نعمل متغير عام يحمل قيمة (مسار الصورة ) وفي التقرير يكفي نداء المتغير اضافة الصور2.rar

وعليكم السلام افتح النموذج وادخل النسبة التي تريدها ...تستطيع ان تفتح تقريرا بذلك مصدرة الاستعلام fatih.rar لم انتبه للجداول!!

يمكنك رفع ملف اخر في موضوع جديد يكون نسخه مصغره من ملفك ببيانات بسيطه لكى نفهم المطلوب جيدا