أحمد العيسى

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

السلام عليكم Year_name هو أحد حقول الجدول tbl_basic وأريد إستخدام محتواه بأحد النماذج فى تكوين اسم جديد من خلال الآتى Dim stDocName As String stDocName = "tbl_student1" & [Year_name] لم يفلح ما سبق ، فقمت بتغيير السطر الثانى إلى: stDocName = "tbl_student1" & [Year_name]![tbl_basic] ورغم عدم وجود خطأ فى الــ Compile لما سبق ، لكن تقابلنى عند التنفيذ هذه الرسالة : ما الخطأ فى التعبير السابق ؟

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

تمام أخى الفاضل Foksh شكراً لك .. هذا ما أريده تماماً وتم التعديل بسهولة لدمج 3 كائنات فى زر أمر واحد ( زر استيراد الجدول ) للتجربة تكون بمراعاة الأرقام الظاهرة على الصورة Test1.mdb

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

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

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

للأسف .. حيث أن العمل على أكسس 2003 فلا يوجد غير هذه المكتبة المرقمة برقم 11 وهى مضافة أصلاً للمشروع لكن يبدو أنها غير كافية لهذا الإصدار والمقصود بالعمل على أكسس 2003 هو توافق هذا العمل حتى على أحدث إصدار لذلك عند التشغيل على أوفيس 2024 تم استبدال المكتبه بالإصدار 16 تلقائياً التى أشار إليها أخى Foksh ومع ذلك عند التنفيذ ظهرت نفس رسالة الخطأ !!!!

تمام شكراً لك .. بارك الله فيك قبل سؤالى استخدمت صفحة 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

السلام عليكم فيما يلى إجراء يقوم بحفظ قاعدة بيانات فى صورة ملف أكسل 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

تمام .. كل الشكر لكما وهذا ما تم تنقيحه ليكون نهائياً ' طباعة المحدد Private Sub cmdPrint_Click() On Error GoTo Err_cmdPrint_Click Dim Index3 As Variant Dim repName As String ' فحص إذا كان هناك بند تم تحديده If L3.ItemsSelected.Count = 0 Then MsgBox "لا يوجد مطبوعات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه " Exit Sub End If ' المرور على كل عنصر محدد وفتح التقرير المقابل له For Each Index3 In L3.ItemsSelected repName = L3.ItemData(Index3) repName = "تقرير_" & repName DoCmd.OpenReport repName, acViewNormal, , ftrName Next Index3 Exit_cmdPrint_Click: Exit Sub Err_cmdPrint_Click: MsgBox Err.Description Resume Exit_cmdPrint_Click End Sub أما عن هذا السطر Private ftrName As String فقد تم التصريح به فى بداية VBA سؤالى هنا : ما هو ftrName هل هو أمر محجوز للطباعة

السلام عليكم الكود التالى يعمل بدون مشاكل ولكن هناك سطور مكررة متداخلة به طلبى من السادة الزملاء ضبط البناء لاختصاره وتحسينه Private Sub cmdPrint_Click() On Error GoTo Err_cmdPrint_Click Dim Index3 As Variant Dim repName As String For Each Index3 In L3.ItemsSelected repName = L3.ItemData(Index3) repName = "تقرير_" & repName Next Index3 If repName = "" Then MsgBox "لا يوجد مطبوغات قد تم اختيارها", vbInformation + vbMsgBoxRight, "تنبيه " Exit Sub Else For Each Index3 In L3.ItemsSelected repName = L3.ItemData(Index3) repName = "تقرير_" & repName DoCmd.OpenReport repName, acViewNormal, , ftrName Next Index3 Exit_cmdPrint_Click: Exit Sub Err_cmdPrint_Click: MsgBox Err.Description Resume Exit_cmdPrint_Click End If End Sub

تم الوصول إلى الحل بالتجربة إذ يبدو أن الخصائص لها أولية عن الكود لذلك تم تغيير خاصية التوسيط للنموذجين بـ "لا" واستدعاء توسيط النموذج عند الفتح باستخدام الكود أعلاه Private Sub Form_Open(Cancel As Integer) CenterFormOnScreen "frm_M1" End Sub

شكراً لك لا يوجد مشكلة ، بل هى ناحية جمالية فقط النموذج الأول يفتح النموذج الثانى فى موضع أعلى منه قليلاً فى الشاشة قبل إغلاق نفسه والنموذج الثانى عند إغلاقه يعيد فتح النموذج الأول فى نفس الموضع الأول أى أسفل قليلاً من النموذج الثانى سأجرب هذا الكود لكل من النموذجين Public Sub CenterFormOnScreen(formName As String) Dim screenWidth As Long Dim screenHeight As Long screenWidth = GetSystemMetrics(SM_CXSCREEN) screenHeight = GetSystemMetrics(SM_CYSCREEN) Dim targetForm As Form Dim formWidthTwips As Long Dim formHeightTwips As Long Dim formWidthPixels As Long Dim formHeightPixels As Long Dim fleftPos As Long Dim ftopPos As Long Set targetForm = Forms(formName) ' الحصول على عرض النموذج وارتفاعه بالتويبس formWidthTwips = targetForm.windowWidth formHeightTwips = targetForm.windowHeight ' تحويل الأبعاد من تويبس إلى بكسل formWidthPixels = formWidthTwips / 15 formHeightPixels = formHeightTwips / 15 ' Calculate left and top positions for centering fleftPos = (screenWidth - formWidthPixels) / 2 ftopPos = (screenHeight - formHeightPixels) / 2 ' اعاده التحويل لوحدة القياس تويبس fleftPos = fleftPos * 15 ftopPos = ftopPos * 15 ' نقل النموذج إلى الموضع المركزي DoCmd.MoveSize fleftPos, ftopPos End Sub

السلام عليكم عندى نموذجين كل منهما عبارة عن "تفصيل ( Detail) فقط " .. لهما نفس الطول ونفس العرض رقمياً أحدهما ينادى الآخر ليحل محله ، فأجد أن الآخر يتموضع فى مكان أعلى قليلاً من النموذج المنادى عليه السؤال : ما هى بنود الخصائص التى توحد ظهور كل منهما فى نفس المكان بشاشة الكمبيوتر بالضبط علماً بأننى مفعل خاصية التوسيط لنموذج كل منهما بـ "نعم" تحياتى وتقديرى لكم

شكراً للسادة الزملاء على تفاعلهم سأجرب نصيحة التشغيل على جهاز آخر عندما يتاح لى أما بالنسبة لتغيير الحدث TimerInterval = 500 وليس 1000 أى التغيير يحدث كل نصف ثانية فالمشكلة ما زالت كما هى بالنسبة للعزيز منتصر الانسي خارج الموضوع : هل من الممكن معرفة كيفية تسجيل ردك بصيغة gif ومن ثم رفعها على المنتدى ؟؟

تمام ، والله أعلم شكراً لك ربما تكون مواصفات جهازى أو نسخة الأكسس 2003 لكن لو لاحظت أننى ذكرت " أحياناً وليس دائم " جرب التشغيل ثم غلق الملف ، ثم تشغيله مرة ثانية

السلام عليكم هو موضوع غير مؤثر ولكنه يدخل فى الناحية الجمالية أحياناً وليس دائماً أجد Lable إظهار الوقت بالثوانى مرتعشاً مع كل ثانية تتغير من المؤكد هناك حل لتثبيت هذا الإرتعاش ، ولكنى لم أسأل عنه من قبل أى زميل هل هناك حل برمجى لهذا المرتعش ؟؟ db1.mdb

أداة مفيدة وجميلة لكن ماذا لو كانت السجلات لا تحتوى على حقول رقمية (نصية فقط حتى العددية منها ) Smart Fillter.accdb

السر يكمن فى سطر الكود أدناه شكراً جزيلاً للسادة الزملاء على تلك المناقشة y = Mid(MyNumber, 2, 2)

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

شكراً أخى Foksh على سرعة الرد تم المطلوب ،وشكراً لك لكن للمعرفة فقط ، لو تم استخدام هذه الدالة من الوحدة النمطية المرفقة Date_Sex_Province([National_Nr], 1) كيف سيكون التصميم ؟

السلام عليكم عندى قاعدة بيانات تحتوى على الكثير من الأرقام القومية فى الحقل National_Nr والمطلوب استخراج تاريخ الميلاد من كل منهم ووضعه فى حقل Birth من خلال استعلام تحديث وأن تكون باستخدام الوحدة النمطية بنفس القاعدة CalculateDate المثال المطلوب التعديل عليه بالمرفقات شكراً جزيلاً مقدماً db1.mdb

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

أضفت بعض التعديلات على كود الحذف فى النموذج المعروض فى أول مشاركة فأصبح التنفيذ ممتاز فى الحذف لأول سجل وما يليه أو بالداخل أو السجل الأخير بدون أى رسائل خطأ أعلم أن بعض الأكواد تكررت ، والمطلوب تكرماً تنظيمها وعدم تكرارها مع الحفاظ على الأداء صفر مشاكل شكراً لكل من شاركنى أفكاره سواء بالرد أو بكتابة الأكواد أو بالنصيحة .. Private Sub Cmdel_Click() On Error GoTo Err_Cmdel_Click If MsgBox(":ستقوم الآن بحذف السجل المسجل بملف رقم" & vbCrLf _ & vbCrLf _ & [Nr] & " " & vbCrLf _ & [Name_T] & vbCrLf _ & " " & vbCrLf _ & "هل أنت متأكد ؟" & vbCrLf _ & "أضغط ( نعم ) للإستمرار ، أو ( لا ) لإلغاء الأمر", vbQuestion + vbYesNo _ + vbMsgBoxRight, "تحذيـــر") = vbYes Then ' ما تم إضافته لتفريغ جميع الحقول غير المرتبطة فى سجل جديد بعد حذف السجل الأخير Me.Retire.Value = "" Me.d.Value = "" Me.m.Value = "" Me.y.Value = "" Me.dd.Value = "" Me.mm.Value = "" Me.yy.Value = "" Me.Retirement.Value = "" '----------------------- Me.Recordset.Delete Me.Recordset.MoveNext ' ما تم إضافته لإعادة حساب جميع الحقول غير المرتبطة فى السجل التالى بعد حذف السجل الذى قبله GetStrat '----------------------- End If Exit_Cmdel_Click: Exit Sub Err_Cmdel_Click: MsgBox Err.Description Resume Exit_Cmdel_Click End Sub db2.mdb