كل الانشطه

كما فهمت: Private Sub أمر0_Click() Dim msgRes As VbMsgBoxResult Const msg = "ماذا تريد ان تفعل Yes فتح نموذج NO فتح تقرير Cancel تراجع " msgRes = MsgBox(msg & vbCrLf & "" & vbCrLf & "الحمدلله", vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "الله المستعان") '--- طريقة أولى ---- If msgRes = vbYes Then DoCmd.OpenForm "22" ElseIf msgRes = vbNo Then DoCmd.OpenReport "33", acViewPreview ElseIf msgRes = vbCancel Then Exit Sub End If '--- طريقة أخرى ---- 'Select Case msgRes ' Case vbYes ' DoCmd.OpenForm "22" ' Case vbNo ' DoCmd.OpenReport "33", acViewPreview ' Case vbCancel ' Exit Sub ' End If 'End Select '--------------- '... End Sub

شكرا لك جزاك الله خير ورحم الله والديك ... جاري التجربة 🌹

تمام ، تم الانتهاء من الشق الأول 👍 الثاني حال وصولي الى الكمبيوتر إن شاء الله ، لأنني خرجت من العمل

الخبير المبدع الذى اتابع كل اعمالة واتعلم منها خالص الشكر لسرعة الاستجابة وإضافة Select Case للبرنامج شكرررررررررا

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

تم تحديث الأداة مع إضافة هذا الخيار

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

ليس لدي أوفيس 2003 ، ولكن جرب هذا التعديل لزر التصدير .. Private Sub cm_ToExcel_Click() On Error GoTo Err_cm_ToExcel_Click Dim stDocName As String Dim filePath As String Dim defaultFolder As String Dim Q As Integer Dim fd As Object stDocName = "tbl_Teacher" & [Year_name] defaultFolder = "D:\Access_Teacher\" Q = DCount("*", "tbl_Teacher") If Q > 0 Then If Dir(defaultFolder, vbDirectory) = "" Then MkDir defaultFolder End If Set fd = Application.FileDialog(2) With fd .Title = "اختر مكان حفظ ملف الإكسل" .InitialFileName = defaultFolder & stDocName & ".xls" If .Show = -1 Then filePath = .SelectedItems(1) If LCase(Right(filePath, 4)) <> ".xls" Then filePath = filePath & ".xls" End If DoCmd.TransferSpreadsheet acExport, 8, "tbl_Teacher", filePath, False MsgBox "تم استخراج ملف الإكسل بنجاح وحفظه في:" & vbCrLf & vbCrLf & _ filePath, vbInformation + vbMsgBoxRight, "" End If End With Else MsgBox "لا يوجد سجلات لتصديرها", vbOKOnly + vbMsgBoxRight, "" End If Exit_cm_ToExcel_Click: Exit Sub Err_cm_ToExcel_Click: MsgBox Err.Description, vbCritical + vbMsgBoxRight, "خطأ" Resume Exit_cm_ToExcel_Click End Sub قمت بتعديل الزر بحيث يعتمد اسم المسار الذي حددته لنا ، وإنشاء المجلد نفسه في المسار إذا لم يكن موجوداً ..

مقدر انشغالكم اساتذتي واخواني الاعزاء. لكن تم الحل. تكرموا باغلاق المزضوع

السلام عليكم Yamen-.zip

هذا لأنك أدخلت السجل بدون أن تدخل التاريخ قمت أنا بإضافة سجل جديد بالرقم 110001 وعندما رجعت للجدول وجدت أن حقل التاريخ فارغ قمت بإدخال تاريخ اليوم ثم قمت بفتح النموذج وأضفت سجل وحددت الرقم 2 فقط فتم تعديله إلى 110002 آلياً كما بالصورة لا تنسى بأن الكود يقوم بإستخراج أحدث تاريخ ثم إستخراج آخر رقم تم إدخاله في هذا التاريخ ليتم الإعتماد عليه أي أنه يعتمد على التاريخ أولاً ثم على أخر رقم في هذا التاريخ لمعالجة المشكلة قمت بتعديل النموذج ليتم تعيين تاريخ اليوم لأي سجل جديد جربه الان وتأكد من النتائج Lab.rar

عذراً إخوانى للعودة لنفس الموضوع قد يكون الموضوع أسهل إذا أرفقت مثال عملى المطلوب أن يكون مربع حوار التصدير ( الحفظ ) مثل المربع الناتج من الضغط على النقاط الثلاث ( الفتح ) للتسهيل : ليكن فولدر الحفظ الإفتراضى (مع إمكانية الاختيار ) هو D:\Access_Teacher عند إستيراد الجدول (داخل مربع الحوار ) هنا لا داعى لوجود مربع اختيار التسمية والضغط على النقاط الثلاث بالنموذج ولكن الفتح والاختيار من أى مكان على الهارد متاح مع وجود فولدر الحفظ الافتراضى داخل الديالوج Test.mdb

الخبير الفاضل foksh الذى لايبخل بعلمة علي احد اشكرك علي اهتمامك ولكني وجدت نمودج فى منتدانا الغالى من إبداع الخبير الفاضل منتصر الانسى لتوليد الرسالة بسهولة والكود مصمم بقاعدة if هذا هو اصرارى علي استخدام قاعدة If لان النموذج تم تصميمة بقاعدة If تستطيع الاطلاع علي النموذج الخاص بعمل كود الرسالة من إبداعات منتصر الانسي

الخبير الفاضل شكرا لابداعك المتجددة لي طلب بسيط ممكن لو تكرمت تستبدل قاعدة If بقاعدة Select Case حتى نتمكن من عمل امر لكل زر فى الرسالة مثلا لو حددنا ٣ ازرار نعم ولا وإلغاء الامر نعم فتح نموذج محدد لا لفتح تقرير محدد الغاء الأمر لغلق الرسالة لانى قمت بتجربة هذا الموضوع نعم يفتح النموذج تمام لا يفتح التقرير تمام الغاء الأمر حاولت بكل الطرق Undo Exit Sub لكنة يكرر الأمر السابق وهو فتح التقرير لذلك ارجوك تحويل قاعدة If إل cselect case لك خالص الشكر

بعد تجربة المرفق ، والتمعن فيه ، مشكلتك أخي الكريم في الجزء :- ElseIf vbNo Then السبب طبعاً أنه لا يفحص نتيجة رد الرسالة الكلي ، بل يعتبر vbNo قيمة ثابتة . وبالتالي يدخل إليه دائماً إذا لم تكن النتيجة vbYes . لذا فالأفضل من وجهة نظري ، والأصح هو استخدام Select Case في حالتك هذه . خلاف ذلك قد نضطر لاستخدام الرسالة مرتين في الجملة الشرطية ، وهذا سيكرر الرسالة مرتين داخل نفس الحدث . لذا جرب الفكرة التالية :- Private Sub أمر0_Click() Select Case MsgBox("ماذا تريد ان تفعل Yes فتح نموذج NO فتح تقرير Cancel تراجع" & vbCrLf & vbCrLf & "الحمدلله", _ vbYesNoCancel + vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, _ "الله المستعان") Case vbYes DoCmd.OpenForm "22" Case vbNo DoCmd.OpenReport "33", acViewPreview Case vbCancel Exit Sub End Select End Sub

شكراً أخى Moosak على مشاركتك بنقل ما تفضلت به للمشروع لم يتغير شئ الكود الوحيد الذى يعمل بلا مشاكل هو كود أخى ابو البشر وإن كان فى حاجة لبعض الإضافات لكنه هو الصحيح بلا أى مشكلة عندى

قمت بمسح السطر واعطى الاتى انظر الصورة

الخبير المبدع شكرا على ابداعك بس حضرتك انا كنت عاوز تعطيل فقط على الكود وهو بنفس الشكل بدون متغيرات كنت كيبت الكلام دة قبل كدة مفيش اى تعديل علي الكود المرسل بدون إضافة Dim result as بدون متغيرات لان الرسالة دى بيتم توليدها من برنامج وجدتي علي الموقع ولا أستطيع التعديل علية انا بكتب عنوان الرسالة ومستواها وعدد الازرار وهو بينتج الكود اريد التعديل علي الكود كما هو هل هذا ممكن البرنامج موجود فى هذا الرابط

تفض د @jo_2010 المرفق بعد التعديل . ووافني بالرد . JO.rar

فقط اوقف السطر أو امسحه لأني نسيته . ' Me.NO_Esal = Me.NEW

تفضل استاذ بلال المرفق . ووافني بالرد . Bilal_Yamen-Last-2.rar

أرى الحل أنك تستغني عن المكتبات تماما بتعريف المتغيرات كـ Object .. رجعت لنفس الأداة وكتبت له : والنتيجة : Private Sub cm_ToExcel_Click() ' تعلن عن المتغيرات المطلوبة Dim stDocName As String Dim Q As Integer Dim objFileDialog As Object ' كائن مربع حوار الملفات (يتم تعريفه كـ Object لعدم استخدام المكتبات) Dim varFilePath As Variant ' المسار الكامل للملف الذي سيتم حفظه (يتم تعريفه كـ Variant لاستقبال قيمة من مربع الحوار) Dim fso As Object ' كائن نظام الملفات للتحقق من وجود محرك الأقراص (يتم تعريفه كـ Object لعدم استخدام المكتبات) Dim drv As Object ' كائن محرك الأقراص (يتم تعريفه كـ Object لعدم استخدام المكتبات) Dim blnDriveEExists As Boolean ' علامة منطقية للتحقق مما إذا كان محرك الأقراص E موجودًا وجاهزًا Dim strDefaultPath As String ' المسار الافتراضي الذي سيتم عرضه في مربع الحوار ' تعيين معالج الأخطاء للانتقال إلى تسمية Err_cm_ToExcel_Click في حالة حدوث خطأ On Error GoTo Err_cm_ToExcel_Click ' بناء اسم المستند بناءً على اسم الجدول وقيمة حقل [Year_name] stDocName = "tbl_Teacher" & [Year_name] ' حساب عدد السجلات في جدول tbl_Teacher Q = DCount("*", "tbl_Teacher") ' التحقق مما إذا كانت هناك سجلات (أكثر من صفر) لتصديرها If Q > 0 Then ' -------------------------------------------------------------------- ' الجزء الخاص بالتحقق من وجود محرك الأقراص E وتعيين المسار الافتراضي ' -------------------------------------------------------------------- ' إنشاء كائن FileSystemObject بدون استخدام مكتبات (Late Binding) ' هذا يسمح بالتحقق من محركات الأقراص دون الحاجة إلى إضافة مرجع لمكتبة Microsoft Scripting Runtime Set fso = CreateObject("Scripting.FileSystemObject") blnDriveEExists = False ' تهيئة العلامة إلى False ' التكرار عبر جميع محركات الأقراص المتاحة للتحقق من وجود محرك الأقراص E For Each drv In fso.Drives If drv.DriveLetter = "E" Then ' إذا كان حرف محرك الأقراص هو "E" If drv.IsReady Then ' والتأكد من أن محرك الأقراص جاهز للاستخدام (ليس فارغًا أو غير متصل) blnDriveEExists = True ' تعيين العلامة إلى True Exit For ' الخروج من الحلقة بمجرد العثور على محرك الأقراص E الجاهز End If End If Next drv ' تعيين المسار الافتراضي لمربع الحوار بناءً على نتيجة التحقق If blnDriveEExists Then strDefaultPath = "E:\" ' إذا كان E موجودًا وجاهزًا، استخدمه كمسار افتراضي Else ' إذا لم يكن E موجودًا أو جاهزًا، استخدم مسار المشروع الحالي كمسار افتراضي strDefaultPath = CurrentProject.Path End If ' تحرير كائنات نظام الملفات لتحرير الذاكرة Set fso = Nothing Set drv = Nothing ' -------------------------------------------------------------------- ' الجزء الخاص بعرض مربع حوار حفظ الملف للسماح للمستخدم باختيار الموقع ' -------------------------------------------------------------------- ' إنشاء كائن مربع حوار الملفات (Application.FileDialog) بدون استخدام مكتبات (Late Binding) ' 2 يمثل msoFileDialogSaveAs (قيمة ثابتة لمربع حوار حفظ باسم) Set objFileDialog = Application.FileDialog(2) ' تهيئة خصائص مربع الحوار With objFileDialog .Title = "اختر مكان حفظ ملف الإكسل" ' تعيين العنوان الذي يظهر في أعلى مربع الحوار .InitialFileName = stDocName & ".xls" ' تعيين الاسم الافتراضي للملف الذي سيتم حفظه .InitialFolder = strDefaultPath ' تعيين المجلد الافتراضي الذي سيتم فتحه عند ظهور مربع الحوار .ButtonName = "حفظ" ' تعيين النص الذي يظهر على زر الحفظ في مربع الحوار .Filters.Clear ' مسح أي فلاتر ملفات موجودة مسبقًا .Filters.Add "ملفات إكسل (*.xls)", "*.xls" ' إضافة فلتر لملفات الإكسل القديمة (Excel 97-2003) .Filters.Add "جميع الملفات (*.*)", "*.*" ' إضافة فلتر لجميع أنواع الملفات .FilterIndex = 1 ' تعيين الفلتر الأول (ملفات إكسل) كفلتر افتراضي ' عرض مربع الحوار والتحقق مما إذا كان المستخدم قد ضغط على زر "حفظ" If .Show = -1 Then ' -1 يعني أن المستخدم ضغط على زر "حفظ" (OK) ' الحصول على المسار الكامل للملف المحدد من قبل المستخدم varFilePath = .SelectedItems(1) ' تصدير البيانات من جدول tbl_Teacher إلى ملف الإكسل بالمسار الذي اختاره المستخدم ' 0 يمثل acExport (قيمة ثابتة لعملية التصدير) ' 8 يمثل acSpreadsheetTypeExcel97 (قيمة ثابتة لنوع ملف الإكسل Excel 97-2003) DoCmd.TransferSpreadsheet 0, 8, "tbl_Teacher", varFilePath, False ' عرض رسالة نجاح للمستخدم تتضمن المسار الذي تم الحفظ فيه MsgBox ("تم استخراج ملف أكسل لبيانات الموظفيـن وحفظه في: " & Chr(13) & Chr(13) & varFilePath), vbOKOnly + vbMsgBoxRight, "تنبيه" Else ' إذا ألغى المستخدم عملية الحفظ (ضغط على Cancel) MsgBox "تم إلغاء عملية حفظ ملف الإكسل.", vbInformation + vbMsgBoxRight, "تنبيه" End If End With ' تحرير كائن مربع حوار الملفات لتحرير الذاكرة Set objFileDialog = Nothing Else ' عرض رسالة إذا لم تكن هناك سجلات في الجدول لتصديرها MsgBox ("لا يوجد سجلات لتصديرها "), vbOKOnly + vbMsgBoxRight, "تنبيه" End If Exit_cm_ToExcel_Click: ' نقطة الخروج العادية من الإجراء Exit Sub Err_cm_ToExcel_Click: ' معالج الأخطاء: عرض وصف الخطأ الذي حدث MsgBox Err.Description, vbCritical, "خطأ" ' استئناف التنفيذ عند نقطة الخروج العادية من الإجراء Resume Exit_cm_ToExcel_Click End Sub

انظر الصور

استاذى الفاضل قمت بتغيير Undo الى Exit Sub واعطى نفس النتيجة السابقة وهو تنفيذ اخر امر فتح التقرير اليك القاعدة للتعديل JO.accdb

السلام عليكم أرجو التمهل قليلا و باذن الله تكون الأمور مستقلا على ما يرام