كل الانشطه

وعليكم السلام ورحمة الله وبركاته .. إليك أخي الفاضل مواضيع قد تم طرحها مسبقاً في المنتدى ، ممكن على سبيل المثال احدثها ..

بدل كلمة Undo ، اجعلها Exit Sub فقط .

دعماً لما تفضل به أستاذنا ابو البشر ، المكتبة الموضحة في الصورة التالية :- طبعاً الرقم 16.0 سيختلف حسب إصدار الأوفيس لديك . فللإصدارات التي أقل من 2016 سيكون الرقم 14.0

هذه هي المكتبة المطلوبة

قمت بتجربة النموذج المرسل من حضرتك يعمل بكفاءة مع الايصالات التى تنتهى ب ٥٥ وعندما كتبت ١٠٠٠ أصبحت القيمة ٥٦٠٠٠ وهذا رائع وقمت بإدخال رقم الإيصال ه أرقام ٥٦٠٠١ ورقم آخر ٠٠٩ أعطى نتيجة رائعة ولكن حاولت تجربة إذا تخطينا ٥٦ بدل رقمين أصبحت ٣ أرقام مثال١٠١٠٠٥ أدخلت رقم إيصال بالكامل ١٠١٠١٩ وسجل جديد كتبت ١٢٢ لم يحتفظ ١٠١ وعاد الي ٥٦ أصبح الإيصال ٥٦١٢٢ بدل ١٠١١٢٢ وهو الرقم الصحيح كيفية حل هذا الوضع هذا الخطأ يظهر لى كثيرا كتبت إيصال ٢٣٠ المفروض ٥٦٢٣٠ قبل منة كان في إيصال ٥٦٢٥٠ يعطى خطا كما بالصورة

تمام شكراً لك .. بارك الله فيك قبل سؤالى استخدمت صفحة vba-code-doctor فأنتج هذا الكود .. لكن به رسالة خطأ أين المشكلة ... هل المطلوب مكتبات معينة ، مع العلم أن الكود ليس به تحذير فى الــ Compile Private Sub cm_ToExcel_Click() On Error GoTo Err_cm_ToExcel_Click Dim stDocName As String Dim Q As Integer Dim fDialog As Office.FileDialog ' يتطلب مرجعًا إلى مكتبة كائنات Microsoft Office XX.0 Dim strFilePath As String stDocName = "tbl_Teacher" & [Year_name] Q = DCount("*", "tbl_Teacher") If Q > 0 Then ' تهيئة مربع حوار الملف Set fDialog = Application.FileDialog(msoFileDialogSaveAs) With fDialog .AllowMultiSelect = False .Title = "اختر مكان حفظ ملف أكسل" .InitialFileName = stDocName & ".xls" .Filters.Clear .Filters.Add "Excel Workbooks", "*.xls", 1 ' تصفية لملفات .xls .FilterIndex = 1 ' تحديد الفلتر الأول افتراضيًا If .Show = True Then ' المستخدم ضغط على حفظ strFilePath = .SelectedItems(1) ' التأكد من أن الملف له امتداد .xls If Right(strFilePath, 4) <> ".xls" Then ' التحقق مما إذا كان هناك امتداد موجود لاستبداله If InStr(strFilePath, ".") > InStrRev(strFilePath, "\") Then strFilePath = Left(strFilePath, InStrRev(strFilePath, ".") - 1) & ".xls" Else strFilePath = strFilePath & ".xls" End If End If DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", strFilePath, False MsgBox ("تم استخراج ملف أكسل لبيانات الموظفيـن وحفظه على الـ " & Chr(13) & Chr(13) & strFilePath), vbOKOnly + vbMsgBoxRight, "تنبيه" Else ' المستخدم ضغط على إلغاء MsgBox "تم إلغاء عملية الحفظ.", vbOKOnly + vbMsgBoxRight, "إلغاء" End If End With Else MsgBox ("لا يوجد سجلات لتصديرها "), vbOKOnly + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: Set fDialog = Nothing ' تنظيف كائن مربع حوار الملف Exit Sub Err_cm_ToExcel_Click: MsgBox Err.Description Resume Exit_cm_ToExcel_Click End Sub

السلام عليكم وكل عام واانتم بالف خير الاساتذه الكرام لدي برنامج اريد عمل شاشه دخول وصلاحيات مستخدمين تصفح فقط او تصفح مع تعديل او كامل تصفح وتعديل وحذف 2008-4 (1).rar

وعليكم السلام Private Sub cm_ToExcel_Click() On Error GoTo Err_cm_ToExcel_Click Dim stDocName As String Dim Q As Integer Dim sh As Object Dim folder As Object Dim FolderPath As String Dim FilePath As String stDocName = "tbl_Teacher_" & [Year_name] Q = DCount("*", "tbl_Teacher") If Q > 0 Then ' اختيار مجلد Set sh = CreateObject("Shell.Application") Set folder = sh.BrowseForFolder(0, "اختر مجلد حفظ الملف", 0) ' لو إلغاء If folder Is Nothing Then Exit Sub FolderPath = folder.Items().Item().Path FilePath = FolderPath & "\" & stDocName & ".xls" ' 🔥 التحقق من وجود الملف If Dir(FilePath) <> "" Then If MsgBox("الملف موجود بالفعل:" & vbCrLf & FilePath & vbCrLf & vbCrLf & _ "هل تريد استبداله؟", _ vbYesNo + vbQuestion + vbMsgBoxRight, "تأكيد") = vbNo Then Exit Sub End If End If ' التصدير DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", FilePath, False MsgBox "تم حفظ الملف بنجاح في:" & vbCrLf & FilePath, vbInformation + vbMsgBoxRight, "تم" Else MsgBox "لا يوجد سجلات لتصديرها", vbExclamation + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: Exit Sub Err_cm_ToExcel_Click: MsgBox Err.Description Resume Exit_cm_ToExcel_Click End Sub

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

السلام عليكم فيما يلى إجراء يقوم بحفظ قاعدة بيانات فى صورة ملف أكسل 2003 على القطاع E والمطلوب إظهار مربع حوار أكسس ليتيح لى حرية اختيار المكان على الهارد قبل الحفظ على أن يكون المكان الافتراضى E فى حالة سماح تقسيم الهارد بذلك مع جزيل شكرى مقدماً Private Sub cm_ToExcel_Click() On Error GoTo Err_cm_ToExcel_Click Dim stDocName As String Dim Q As Integer stDocName = "tbl_Teacher" & [Year_name] Q = DCount("*", "tbl_Teacher") If Q > 0 Then DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", "E:\" & stDocName & ".xls", False MsgBox (" E:\ تم استخراج ملف أكسل لبيانات الموظفيـن وحفظه على الـ " & Chr(13) & Chr(13) & stDocName & ".xls"), vbOKOnly + vbMsgBoxRight, "تنبيه" Else MsgBox ("لا يوجد سجلات لتصديرها "), vbOKOnly + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: Exit Sub Err_cm_ToExcel_Click: MsgBox Err.Description Resume Exit_cm_ToExcel_Click End Sub

أنت هنا تريد أتمتة عمل مرتبط بعمل خارج نطاق التطبيق بمعنى أنت لاتعلم ماذا سيكون رقم الدفتر الجديد هل هو الرقم التالي أم رقم سابق كان قد تم السهو عنه من قبل امين الصندوق أو أو أو .... هذا يعني أن إحتمالات المتغيرات الخارجية ستكون كثيرة لذا فأفضل خيار لديك هو أن تجعل البرنامج يقوم بقراءة آخر إيصال والإحتفاظ بآخر رقمين منه ثم إضافتهما لرقم الإيصال الجديد وللحصول على النتيجة وفق طلبك هذا قمت بتعديل ملفك الأصلي للحصول على هذه النتيجة - عند إدخال رقم الإيصال سيقوم النموذج بالتعامل معه بناءاً على الرقم - إذا كان أقل من أو يساوي 1000 سيتم إرجاع رقم آخر إيصال تم إدخاله وإضافته للرقم الذي قمت بإدخاله (عندما يكون 1000 سيبدأ الدفتر التالي) - قد تضطر أحيانا لتصحيح رقم إيصال كنت قد أدخلته بالغلط عندها يمكنك إدخال الرقم كاملاً (5 أرقام أي أكبر من 1000) عندها سيتم الإحتفاظ بالرقم كما أدخلته - إذا صادف وتم بدء العمل بدفتر برقم سابق أو ليس الرقم الذي يلي الرقم الحالي عندها ستكون مضطر لإدخال الرقم كاملا (أو تصحيح الرقم) لأول إيصال فقط وبعدها سيتم التعامل مع هذا الرقم الجديد - جرب إجراء كل التعديلات التي يمكن أن تواجهها في العمل وتأكد من أن النتائج ستكون مطابقة للنتائج المرجوة منها أم لا Lab.accdb

معلمى الفاضل الدفتر الحالى ينتهى ٥٥ فقولت اثبتهم واكتب ٣ أرقام فقط بدل ما اكتب كل رقم الايصال ٥ أرقام ممكن الدفتر اللي بمنتهى ٥٥ يخلص بعد شهر مش سنة ونجيب دفتر جديد ينتهى ٥٦ انا كنت عامل فى المرفق المرسل ٢ حقل واحد اكتب اخر رقمين كافتراضى والثاني ٣ ارقام متغير وحقل ثالث يضم الحقلين وبعدين قولت بدل ٣ حقول أعرض الأمر علي أصحاب الخبرة لجعل الثلاثة حقول حقل واحد لكم الشكر جميعا

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

السلام عليكم موضوع خاص بالاجازات السنوية 1- اريد عند طلب موظف اجازة سنوية للمدة 30 يوما مثل من 1-03-2026 الى 30-03-2026 و عند إعادة طلب مرة اخر إجازة لنفس الموظف لا يسطيع حساب الاجازة تكون عند حجز تاريخ بدء الاجازة و عدد أيام الاجازة تظهر تاريخ نهاية الاجازة وفي النموذج forma اريد عند الضغط على معلومات الموظف لاضافة اجازة جديدة يتم التلوين معلوته وتوجد في النموذج خانة صفراء اريد عندما يكون الموظف في الاجازة تظهر في الخانة اجازة لم تنتهي باللون الاحمر وعند الانتهاء تظهر الاجازة انتهت بالون الاخضر واريد ان يظهر خانة الصفراء على شكل متحرك . جدول tblLeave خاص بمعلومات الاجازات ونموذج tblLeave26 معلومات طلب اجازة الاجازات.zip

معلومة مهمة ، وطرف الخيط هذا ثمين جداً 🤗 بارك الله فيك اخي جعفر 💐

جرب هذا Dim result As VbMsgBoxResult result = MsgBox("ماذا تريد ان تفعل اضغط Yes لفتح النموذج NO لفتح التقرير Cancel للتراجع" & vbCrLf & vbCrLf & "الحمدلله", _ vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "الله المستعان") If result = vbYes Then DoCmd.OpenForm "22" ElseIf result = vbNo Then DoCmd.OpenReport "33", acViewPreview ElseIf result = vbCancel Then Exit Sub ' 👈 هنا يخرج بدون أي إجراء End If

السادة الخبراء الافاضل If MsgBox("ماذا تريد ان تفعل اضغط Yes لفتح النموذج NO لفتح التقرير Cancel للتراجع " & vbCrLf & "" & vbCrLf & "الحمدلله", vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "الله المستعان") = vbYes Then DoCmd.OpenForm "22" ElseIf vbNo Then DoCmd.OpenReport "33", acViewPreview ElseIf vbCancel Then Undo Else End If كتبت الكود بهذا الشكل ويعمل بصورة جيدة ولكن عند الضغط علىcancel يقوم بتنفيذ الامر السابق وهو فتح التقرير اريد عند الضفط على cancel غلق الرسالة اريد التعديل على هذا الكود بقاعدة if دون استخدام sselect Case

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

نعم الموقع ثقة ، وانا اشرت الى هذا في الرابط التالي ، وهناك رد من الاخ @محمد سلامة عن طريقة لا اعرفها:

الخبير المبدع kkhalifa1960 شكرا على ابداعك ولكن عندما توقف على السجل ظهرت لى 55 كتبت 1000 55 تحولت الى 56 شئ جميل عند كتابة سجل جديد ظهرت 55 ولم تظهر 56 اريد ان تصبح 56 قيمة افتراضية لاضافة باقى ارقام الايصال ___56 وهكذا كما صادفتنى مشكلة اخرى عندما تحول الرقم من 55 الى 56 وكتبت رقم ايصال جديد 56015 مثلا واردت تعديل 15 لتصبح 18 مثلا عند التوقف بالمؤشر على الحقل للتعديل اجد 56 عادت 55 كما كانت اعتذز على ازعاج حضرتك بطلبى

استاذ الفاضل بارك الله فيك شكرا جزيلا استاذ رسالة تنبه قبل مسح البيانات فقط استاذ عند عدم ادخال رقم التسجيل لم يتم معاينة الطباعة استاذ لقد قمت بجريب الملف في جهاز كمبيوتر أخر عند حدف موطف وتقوم بحدف موظف اخر تظهر بان الخلية محمية وعند مسح البيانات تظهر خطأ وهكذا عند في خلية ولاية الميلاد عند تحديد ولاية الميلاد استاذ بارك الله فيك هل تسطيع عند ترحيل اذا كانت متطابقة ومتكررة لايتم التسجيل اليك الملف Plateform (1) (2) (1) (1).xlsb

اخى العزيز جربت الملف جميع الاكواد تعمل حذف الموظف يعمل-حذف الكل يعمل - معاينة الطباعة يعمل - كلها تعمل لدي بدون اي اخطاء ارفق الملف الذي تظهر به الاخطاء

اسمحوا لي اساتذتي كي نوقف الجدل ولحل هذا الموضوع على الاستاذ @أبو سلمى ارسال القاعدة بامتداد ( mdb. أو Accdb. ) لعمل اللازم كي تعمل على 23 بت و 64 بت .

اليكم الشرح والمرفق . DD13901390-1.rar