M.Abd Allah

طيب جرب الكود ده كده عند الضغط علي تاب ومعاه شيفت هينقلك الحقل السابق وعند الضغط علي تاب فقط هينقلك علي الحقل التالي جرب ووافيني بالنتيجه Public Function HandleKeyDown(KeyCode As Integer, Shift As Integer) As Integer If KeyCode = 9 Then ' Tab key If (Shift And acShiftMask) > 0 Then ' Shift + Tab (go to previous control) SendKeys "+{TAB}" Else ' Tab (go to next control) SendKeys "{TAB}" End If HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي ElseIf KeyCode = 115 Then ' F4 Form_Form1.k1.SetFocus HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي ElseIf KeyCode = 114 Then ' F3 Form_Form1.k5.SetFocus HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي Else HandleKeyDown = KeyCode ' لإعادة KeyCode الأصلي لتمكين إدخال البيانات في الحقل End If End Function Private Sub k1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k2_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k3_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k4_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k5_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub

جرب وقولي انا فى انتظارك

طيب استخدم التعديل ده وقولي النتيجه Public Function HandleKeyDown(KeyCode As Integer, Shift As Integer) As Integer If KeyCode = vbKeyTab Then ' Tab key HandleKeyDown = KeyCode ' احتفظ بالسلوك الافتراضي للتاب ElseIf KeyCode = 115 Then ' F4 Form_Form1.k1.SetFocus HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي ElseIf KeyCode = 114 Then ' F3 Form_Form1.k5.SetFocus HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي Else HandleKeyDown = KeyCode ' لإعادة KeyCode الأصلي لتمكين إدخال البيانات في الحقل End If End Function Private Sub k1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k2_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k3_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k4_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k5_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub

السلام عليكم بالمشاركه مع جميع العمالقه اللي ردوا عالتعليقات وخاصه ابو جودى وتعديل علي طريقته اللي حضرتك قولتي عليها انها زي اللي انتي عايزاه بس عايزه فى كل مره تضيف فالتكست بتاعك القيمه اللي تختاريها مشاركتى عشان الموضوع زاد فى اكتر من صفحه نصيحه اخويه حضرتك حددي اللي انتي عايزاه كله مره واحده وبالتفصيل فالملف عشان الناس تقدر تفيدك محدش بيدعي عليكي او بيظلمك فى وجهه نظره لان حضرتك مبتقوليش طلبك كامل + ان كل شويه طلب مختلف + ان ممكن بعد شهر تفتكري او تبيقي عايزه تعدلي حاجه ترجعي تعملي منشن رغم ان الموضوع زي مبيقولو بلغه البحث العلمي بيبقي قتل بحثا ( اتعمل اكتر من مره ) اسف لوجهه نظري ولو مش علي هواكي ارميها فالسله (القمامه ) انا من اسلوبك كنت مقرر اني مش هشارك تاني بس قولت المره دي اقول وجهه نظري بجزء من الاستفاضه لاني جديد عليكم يعني مفيش معزه بيني وبين حد عشان اتحرج زي غيري واسف جدا جدا جدا عالاطاله ((((((( ولو مش هو ده المطلوب زي محضرتك طلبيتيه فمشاركاتك وظلمتي اغلب اللي عملوه بالظبط بس بوجهه نظرهم )))))))) انا مستعد ابطل اكسس ان شاء الله safaa_nn.accdb

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

وعليكم السلام ورحمه الله وبركاته هتعمل نموذج فيه كمبوبوكس لتحديد نوع الطابعه نفترض اسمه cmbPrintType وتخلى مصدر الصف بتاعه الطابعات من جدول الطابعات بتاعك وتعمل زار للطباعه نفترض أنه btnPrint وتخلي ده الكود بتاعه Private Sub btnPrint_Click() Dim printType As String ' تحقق من أن هناك قيمة مختارة في مربع التحرير والسرد If IsNull(Me.cmbPrintType) Then MsgBox "الرجاء اختيار نوع الطباعة.", vbExclamation Exit Sub End If ' احصل على نوع الطباعة المختار printType = Me.cmbPrintType.Column(1) ' طباعة التقرير بناءً على نوع الطباعة Select Case printType Case "طباعة حرارى" DoCmd.OpenReport "ThermalPrintReport", acViewPreview ' استبدل "ThermalPrintReport" باسم تقرير الطباعة الحرارية Case "طباعة A5" DoCmd.OpenReport "A5PrintReport", acViewPreview ' استبدل "A5PrintReport" باسم تقرير طباعة A5 Case Else MsgBox "نوع الطباعة غير معروف.", vbExclamation End Select End Sub

وعليكم السلام ورحمه الله وبركاته تقدر تستخدم الطريقه دي هتعمل الداله دي فى module وتحفظها باي اسم بالطريقه دى يبقي حضرتك عملت ا لكود مره واحده وبتستدعيه كل متحب Public Function HandleKeyDown(KeyCode As Integer, Shift As Integer) As Integer If KeyCode = 115 Then ' F4 Form_Form1.k1.SetFocus HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي ElseIf KeyCode = 114 Then ' F3 Form_Form1.k5.SetFocus HandleKeyDown = 0 ' لمنع إدخال بيانات في الحقل الحالي Else HandleKeyDown = KeyCode ' لإعادة KeyCode الأصلي لتمكين إدخال البيانات في الحقل End If End Function هفترض أن لديك نموذج يحتوى على عده حقول k1,k2,k3,k4,k5 وعايز تطبق نفس الكود علي جميع هذه الحقول هتعمل فى حدث keydown لكل حقل كالاتى Private Sub k1_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k2_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k3_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k4_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub Private Sub k5_KeyDown(KeyCode As Integer, Shift As Integer) KeyCode = HandleKeyDown(KeyCode, Shift) End Sub

بتهنيه علي ايه يا بروف دا طلع بيذاكر من ورانا 🤣🤣

كده الارتفاع اتظبط زي مانتي عايزه عدلت الكود بحيث يظهر بشكل حلو ولو حابه تغيري فالارتفاع شويه تقدري تعدلى فالقيمه Header - Safaa.accdb

مهو نفس التقرير دا مبيظهرليش فالملف المرفق موجود ٤ تقارير ومش لاقي فيهم مشكله صراحه عشان كده مستغرب فين المشكله

الله ينور عليك يا عبقرينو 😊😊 مش بقولك بتذاكر من ورانا

انا للاسف مش فاهم حاجه

انا مش شايف ايه غلط فالبيانات اللي بعتيها

هبص عالملف أن شاءالله انهارده احللك المشكله

استاذ عبدو الموضوع شيق ولكن شرحك غير وافى مثال عندك الاسماء دلوقتي وعايز توزعها علي ورديات خلال الشهر وايضا خلال العام كله ولكن لم تذكر مثلا هل العامل ممكن يتوزع ع اكتر من ورديه ولا هي ورديه واحده خلال نفس المهمه طيب دلوقتي مثلا لو عندك ٢٠ عامل لورديه معينه كده هيكون مثلا بدايه من اول اسم الي الاسم رقم ٢٠ خلال عشرين يوم وبعدها يبدأ اسم ١ تاني يوم ٢١ الي اخر يوم فالشهر وينتهي عند اسم ١٠ لو شهر ٣٠ يوم بدايه من الشهر اللي بعده المفروض الكشف يبدأ من العامل رقم ١١ وهكذا ؟؟؟ ولا ايه ضوابط وقواعد توزيع الورديات عندك وهل ممكن اكتر من عامل يبقي في ورديات مختلفه لنوعيات اشغال مختلفه ولا ايه طيب هل كل العمال بيشتغلوا كل الايام عالتوالي ولا عندك راحت اسبوعيه وبيتم توزيع فيها ناس معينه طب في حاله الاجازات والأعياد الرسميه ايه نظامها عندك هل الكشف بيفضل يتوزع عادي ولا بيكون ناس معينه برضو مهم جدا جدا جدا تكتب تفاصيل العمل اللي انت عايزه بالظبط عشان تحصل علي ما تريد ايضا في حاله الاجازات المرضية أو السنويه للعمال أو العرضيات وما الي ذلك هل هيتم برضو توزيعهم اتوماتيك علي الورديات ولا للبرنامج المفروض يستثني الناس اللي في اجازات أو في مواقف معينه وهكذا ذكرك لتفاصيلك الكامله مهم جدا جدا جدا

السلام عليكم ورحمه الله وبركاته دكتورنا الفاضل Foksh دا اسم مستعار للبروف المبدع ( فادي ) أو ابو وسام وليس فايد بعتذر عن المقاطعه بس اعتقد حضرتك اللي بتستعجل فالردود راجع التعليقات من الاول بتأني هتلاقي طلب حضرتك تم حله بواسطه البروف فادي والعلامه أبو خليل أو تنتظر لحين اكتمال الاسطوره أبو جودي من انتهائه من عمل الملف اللي حضرتك استخدمته قبل كده ليكون سهل عليك استخدامه أعتذر مره اخري عن المقاطعه دي مجرد وجهه نظرى لو أسأت الفهم يمكن تجاهلها تحياتي

واااااالعه يا بروف 😉 😉

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

جربي الكود ده إن شاءالله هيظبط معاكي On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim fixedDefaultValue As Variant Dim fixedNormalValue As Variant Dim reportNameValue As Variant Dim sql As String Dim MAXCODE As Long ' الحصول على القيم من الحقول fixedNameValue = Me.testnameN newResultValue = Me.Newresult fixedDefaultValue = Me.fixeddefault fixedNormalValue = Me.fixednormal reportNameValue = Me.Reportname ' التحقق من أن الحقول الثلاثة ليست فارغة If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation Exit Sub End If ' التحقق من أن القيم ليست فارغة If IsNull(fixedNameValue) Or IsNull(newResultValue) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' التحقق من عدم تكرار السجل في fixedresults_tbl sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF And rs!RecordCount > 0 Then MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation rs.Close Set rs = Nothing Set db = Nothing Exit Sub End If rs.Close Set rs = Nothing ' الحصول على قيمة الكود الجديدة MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0) Me.code.Value = MAXCODE + 1 ' إضافة السجل الجديد في fixedresults_tbl sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _ "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')" db.Execute sql, dbFailOnError ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fixedNameValue & "'" Set rs = db.OpenRecordset(sql, dbOpenDynaset, dbSeeChanges) If rs.EOF Then rs.AddNew rs!fixedname = fixedNameValue rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update Else rs.Edit rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update End If rs.Close Set rs = Nothing Set db = Nothing ' تحديث القائمة وإعلام المستخدم Resultlist.Requery Newresult.Value = "" MsgBox "تمت الإضافة بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing End If

انت استاذ كبير أيها المشاكس بصراحه الملف ممتاز وشغل عالي ابدعت وتألقت فعلا

تقدر تضيف اكتر من سنه بنفس الطريقه انا زودت لحضرتك سنتين وتقدر تزود اكتر من سنه بنفس الطريقه Private Sub x_AfterUpdate() If x1 <> 0 Then ' لا تفعل شيئًا إذا كانت x1 ليست صفرًا Else Select Case x Case "1446" x1 = Nz(DMax("[m]", "mm", "yy = '1446'") + 1, 4600001) Case "1447" x1 = Nz(DMax("[m]", "mm", "yy = '1447'") + 1, 4700001) Case "1448" x1 = Nz(DMax("[m]", "mm", "yy = '1448'") + 1, 4800001) Case "1449" x1 = Nz(DMax("[m]", "mm", "yy = '1449'") + 1, 4900001) ' يمكنك إضافة حالات أخرى للأعوام الأخرى بنفس الطريقة Case Else MsgBox "السنة غير مدعومة." End Select End If End Sub

اللهم امين معلشي والله انشغلت شويه بس البروفيسور شايب العملاق حلها

هو فعلا بروف يا جراحنا العظيم

عادي مفيش مشكله On Error GoTo ErrorHandler Dim db As DAO.Database Dim rs As DAO.Recordset Dim fixedNameValue As String Dim newResultValue As String Dim fixedDefaultValue As Variant Dim fixedNormalValue As Variant Dim reportNameValue As Variant Dim sql As String Dim MAXCODE As Long ' الحصول على القيم من الحقول fixedNameValue = Me.testnameN newResultValue = Me.Newresult fixedDefaultValue = Me.fixeddefault fixedNormalValue = Me.fixednormal reportNameValue = Me.Reportname ' التحقق من أن الحقول الثلاثة ليست فارغة If IsNull(fixedDefaultValue) Or IsNull(fixedNormalValue) Or IsNull(reportNameValue) Then MsgBox "يرجى استكمال باقي البيانات (fixeddefault, fixednormal, Reportname) قبل الإضافة.", vbExclamation Exit Sub End If ' التحقق من أن القيم ليست فارغة If IsNull(fixedNameValue) Or IsNull(newResultValue) Then MsgBox "يرجى ملء جميع الحقول قبل الإضافة ثم الضغط على الزرار", vbExclamation Exit Sub End If ' فتح قاعدة البيانات Set db = CurrentDb ' التحقق من عدم تكرار السجل في fixedresults_tbl sql = "SELECT COUNT(*) AS RecordCount FROM fixedresults_tbl WHERE Fixedname = '" & fixedNameValue & "' AND Fixedresult = '" & newResultValue & "'" Set rs = db.OpenRecordset(sql) If Not rs.EOF And rs!RecordCount > 0 Then MsgBox "القيمة المدخلة موجودة مسبقاً.", vbExclamation rs.Close Set rs = Nothing Set db = Nothing Exit Sub End If rs.Close Set rs = Nothing ' الحصول على قيمة الكود الجديدة MAXCODE = Nz(DMax("code", "fixedresults_tbl"), 0) Me.code.Value = MAXCODE + 1 ' إضافة السجل الجديد في fixedresults_tbl sql = "INSERT INTO fixedresults_tbl (code, Fixedname, Fixedresult) " & _ "VALUES (" & Me.code.Value & ", '" & fixedNameValue & "', '" & newResultValue & "')" db.Execute sql, dbFailOnError ' تحديث القائمة Resultlist.Requery Newresult.Value = "" ' فتح الجدول Fixed_tbl للتحقق من وجود السجل وتحديثه أو إضافته sql = "SELECT * FROM Fixed_tbl WHERE fixedname = '" & fixedNameValue & "'" Set rs = db.OpenRecordset(sql) If rs.EOF Then rs.AddNew Else rs.Edit End If rs!fixedname = fixedNameValue rs!fixeddefault = fixedDefaultValue rs!fixednormal = fixedNormalValue rs!Reportname = reportNameValue rs.Update rs.Close Set rs = Nothing Set db = Nothing MsgBox "تمت الإضافة بنجاح!", vbInformation Exit Sub ErrorHandler: MsgBox "حدث خطأ: " & Err.Description, vbCritical If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing End If

وعليكم السلام ورحمه الله وبركاته شوف كده دا اللي انت عايزه ولا لاء جلب قيمه1.accdb