ابو جودي

وكما قلت دائما وابدا هناك طريقة رمهانية http://www.officena.net/ib/index.php?showtopic=61621&p=397839 New-up- بالطريقة الرمهانية.rar كل الشكر والتقدير استاذ رمهان جزانا الله واياكم خير الجزاء ولكن انت الاستاذ انا اقل طالب علم فى هذا الصرح الشامخ

حتما هناك طريقه رمهانية لاختزال الكــــــود ونحن فى الانتظار

اتفضل New تطبيق-up.rar اتمنى تجد ضالتك كما تتمنى ان شاء الله

انا لى راى يا استاذ ahmedabuzena انت حددت عدد فتحات للقاعده بتاعتك طيب لو النور قطع راحت واحده من العدد ولو الجهاز هنج وقفل وفتح القاعده راحت واحده ولو قفل الجهاز وفتحه كذلك راحت واحده لو القاعده اتقفلت واتفتحت بالغلط راحت واحده برضو اعتقد لو تم من خلال التاريخ وتحديد عدد ايام افضل من عدد فتحات للقاعده صح واللا كلامى غلط ؟!

ولكن سننفذه بطريقة رمهانية هههههههههههههههههههههههههههههههه هذا اهم ما فى الموضوع الطريقة الرمهانية استاذ رمهان بجد انت معلم قدير

ده مثال لاظهار واخفاء جميع كائنات الاكسس بما فى ذلك الجداول المرتبطه إخفاء جميع كائنات أكسس.rar

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

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

طب ممكن نقول دى بداية ونعدل براحتنا بعد كده لو البدايه مقبوله nor.rar

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

طيب ع العموم استنى المرفق اهو انا اسف انا كنت لاغى القوائم كل الاكواد داخل الفورم mainfrm إخفاء واظهار الجداول والكائنات.rar

ولكن ينقصه أنه غير مفتوح للسورس كود ؟ ازاى اومال ده ايه ؟ Option Compare Database Private Sub Command27_Click() Dim msg, style, title, result msg = "ÓíÊã ÊæÞíÝ ÇáÔíÝÊ" style = vbYesNo title = " ÊÍÐíÑ - ÅíÞÇÝ ãÝÊÇÍ" result = MsgBox(msg, style, title) If result = vbYes Then ChangeProperty "AllowBypassKey", DB_BOOLEAN, False MsgBox "Êã ÅíÞÇÝ ÇáÔíÝÊ", vbInformation, "ÅÊãÇã ÇáÚãáíÉ" ElseIf result = vbNo Then DoCmd.CancelEvent MsgBox "Êã ÇáÊÑÌÚ Úä ÇíÞÇÝ ÇáÔíÝÊ", vbInformation, "ÅáÛÇÁ ÇáÚãáíÉ" End If End Sub Private Sub Command28_Click() Dim msg, style, title, result msg = "ÓíÊã ÊÝÚíá ÇáÔíÝÊ" style = vbYesNo title = " ÊÍÐíÑ - ÅíÞÇÝ ãÝÊÇÍ" result = MsgBox(msg, style, title) If result = vbYes Then ChangeProperty "AllowBypassKey", DB_BOOLEAN, True MsgBox "Êã ÊÝÚíá ÇáÔíÝÊ ", vbInformation, "ÅÊãÇã ÇáÚãáíÉ" ElseIf result = vbNo Then DoCmd.CancelEvent MsgBox "Êã ÇáÊÑÌÚ Úä ÊÝÚíá ÇáÔíÝÊ", vbInformation, "ÅáÛÇÁ ÇáÚãáíÉ" End If End Sub Private Sub ÅÎÝÇÁ_ÇáÊÞÇÑíÑ_Click() On Error Resume Next Dim obj As AccessObject Dim dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllReports SetHiddenAttribute acReport, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 End Sub Private Sub ÅÎÝÇÁ_ÇáãÇßÑæÇÊ_Click() On Error Resume Next Dim obj As AccessObject Dim dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllMacros SetHiddenAttribute acMacro, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 End Sub Private Sub ÅÎÝÇÁ_ÇáäãÇÐÌ_Click() On Error Resume Next DoCmd.Close Dim db As Database Dim obj As AccessObject Set dbs = Application.CurrentProject For Each obj In dbs.AllForms SetHiddenAttribute acForm, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 DoCmd.OpenForm "mainfrm" End Sub Private Sub ÅÎÝÇÁ_ÇáæÍÏÇÊ_Click() On Error Resume Next Dim obj As AccessObject Dim dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllModules SetHiddenAttribute acModule, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 End Sub Private Sub ÅÙåÇÑ_ÇáÊÞÇÑíÑ_Click() Dim obj As AccessObject Dim dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllReports SetHiddenAttribute acReport, obj.Name, False Next obj End Sub Private Sub ÅÙåÇÑ_ÇáãÇßÑæÇÊ_Click() On Error Resume Next Dim obj As AccessObject Dim dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllMacros SetHiddenAttribute acMacro, obj.Name, False Next obj End Sub Private Sub ÅÙåÇÑ_ÇáäãÇÐÌ_Click() On Error Resume Next DoCmd.Close Dim obj As AccessObject Dim dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllForms SetHiddenAttribute acForm, obj.Name, False Next obj DoCmd.OpenForm "mainfrm" End Sub Private Sub ÅÎÝÇÁ_ãÚ_ÅÙåÇÑ_ÈÇáÎíÇÑÇÊ_Click() Dim obj As AccessObject, dbs As Object Set dbs = Application.CurrentData For Each obj In dbs.AllTables If Left(obj.Name, 4) <> "MSys" Then SetHiddenAttribute acTable, obj.Name, True Next obj End Sub Private Sub ÅÎÝÇÁ_ãÚ_ÚÏã_ÅÙåÇÑåÇ_ÈÇáÎíÇÑÇÊ_Click() Dim db As Database Dim obj As AccessObject, dbs As Object Dim tdf As TableDef Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllTables Set tdf = db.TableDefs(obj.Name) If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then tdf.Attributes = tdf.Attributes + dbHiddenObject End If Next Set tbl = Nothing db.Close Set db = Nothing End Sub Private Sub ÅÙåÇÑ_ÇáæÍÏÇÊ_Click() On Error Resume Next Dim obj As AccessObject Dim dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllModules SetHiddenAttribute acModule, obj.Name, False Next obj End Sub Private Sub ÅÙåÇÑ_ãÚ_ÅÎÝÇÆåÇ_ÈÇáÎíÇÑÇÊ_Click() Dim obj As AccessObject, dbs As Object Set dbs = Application.CurrentData For Each obj In dbs.AllTables If Left(obj.Name, 4) <> "MSys" Then SetHiddenAttribute acTable, obj.Name, False Next obj End Sub Private Sub ÅÙåÇÑ_ãÚ_ÚÏã_ÅÙåÇÑåÇ_ÈÇáÎíÇÑÇÊ_Click() Dim dbs As Database, tdf As TableDef Set dbs = CurrentDb For Each tdf In dbs.TableDefs If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 _ And tdf.Attributes = 1 Then tdf.Attributes = tdf.Attributes - dbHiddenObject End If Next tdf Set dbs = Nothing End Sub Private Sub ÃãÑ14_Click() On Error GoTo Err_ÃãÑ14_Click DoCmd.Close Exit_ÃãÑ14_Click: Exit Sub Err_ÃãÑ14_Click: MsgBox Err.Description Resume Exit_ÃãÑ14_Click End Sub Private Sub ÃãÑ16_Click() Dim db As Database Dim obj As AccessObject, dbs As Object Dim tdf As TableDef Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 Set tdf = Nothing db.Close Set db = Nothing End Sub Private Sub ÃãÑ17_Click() Dim db As Database Dim obj As AccessObject, dbs As Object Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.Name, False Next obj Set tdf = Nothing db.Close Set db = Nothing End Sub Private Sub ÃãÑ18_Click() Dim db As Database Dim obj As AccessObject, dbs As Object Dim tdf As TableDef Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllTables Set tdf = db.TableDefs(obj.Name) If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then tdf.Attributes = tdf.Attributes + dbHiddenObject End If Next For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 Set tdf = Nothing db.Close Set db = Nothing End Sub Private Sub ÃãÑ20_Click() Dim db As Database Dim obj As AccessObject, dbs As Object Dim tdf As TableDef Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllTables Set tdf = db.TableDefs(obj.Name) If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then tdf.Attributes = tdf.Attributes + dbHiddenObject End If Next For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.Name, True Next obj DoCmd.Close Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 Set tdf = Nothing db.Close Set db = Nothing End Sub Function hiddenobj() Dim obj As AccessObject Dim dbs As Object Dim qry As QueryDefs Set db = CurrentDb Set dbs = Application.CurrentProject For Each obj In dbs.AllReports SetHiddenAttribute acReport, obj.Name, True Next obj For Each obj In dbs.AllMacros SetHiddenAttribute acMacro, obj.Name, True Next obj For Each obj In dbs.AllModules SetHiddenAttribute acModule, obj.Name, True Next obj DoCmd.Close For Each obj In dbs.AllForms SetHiddenAttribute acForm, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 End Function Function TQ_hidden() Dim db As Database Dim obj As AccessObject, dbs As Object Dim tdf As TableDef Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllTables Set tdf = db.TableDefs(obj.Name) If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 Then tdf.Attributes = tdf.Attributes + dbHiddenObject End If Next For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.Name, True Next obj Application.SetOption "Show Hidden Objects", 0 Application.SetOption "Show System Objects", 0 Set tdf = Nothing db.Close Set db = Nothing End Function Private Sub ÃãÑ21_Click() Call hiddenobj Call TQ_hidden DoCmd.OpenForm "mainfrm" End Sub Function TQshow() Dim db As Database Dim obj As AccessObject, dbs As Object Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.Name, False Next obj Set dbs = CurrentDb For Each tdf In dbs.TableDefs If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 _ And tdf.Attributes = 1 Then tdf.Attributes = tdf.Attributes - dbHiddenObject End If Next tdf Set dbs = Nothing db.Close Set db = Nothing End Function Function objshow() Dim obj As AccessObject Dim dbs As Object Dim qry As QueryDefs Set db = CurrentDb Set dbs = Application.CurrentProject For Each obj In dbs.AllReports SetHiddenAttribute acReport, obj.Name, False Next obj For Each obj In dbs.AllMacros SetHiddenAttribute acMacro, obj.Name, False Next obj For Each obj In dbs.AllModules SetHiddenAttribute acModule, obj.Name, False Next obj DoCmd.Close For Each obj In dbs.AllForms SetHiddenAttribute acForm, obj.Name, False Next obj End Function Private Sub ÃãÑ23_Click() Call objshow Call TQshow DoCmd.OpenForm "mainfrm" End Sub Private Sub ÃãÑ24_Click() Dim db As Database Dim obj As AccessObject, dbs As Object Dim qry As QueryDefs Set dbs = Application.CurrentData Set db = CurrentDb For Each obj In dbs.AllQueries SetHiddenAttribute acQuery, obj.Name, False Next obj Set dbs = CurrentDb For Each tdf In dbs.TableDefs If Left(tdf.Name, 4) <> "msys" And tdf.Attributes <> 1073741824 _ And tdf.Attributes = 1 Then tdf.Attributes = tdf.Attributes - dbHiddenObject End If Next tdf Set dbs = Nothing db.Close Set db = Nothing End Sub Public Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) Dim dbs, prp As Property Const conPropNotFoundError = 3270 Set dbs = CurrentDb On Error GoTo Change_err dbs.Properties(strPropName) = varPropValue ChangeProperty = True Change_Bye: Exit Function Change_err: If Err = conPropNotFoundError Then Set prp = dbs.CreateProperty(strPropName, varPropType, varPropValue) dbs.Properties.Append prp Resume Next Else ChangeProperty = False Resume Change_Bye End If End Function

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

راعى الغنم اخ جميل واستاذ عزيز جدا جدا على قلوبنا ونسيت التوقيع عالم مارد تسلم ايدك

طيب اولا المساعده لله ولوجه الله 11 قاعه هل لهم اسماء ؟! 14 معمل نفس السؤال المطروح هل لهم اسماء - مواعيد الحجز هل كل الايام ؟ - اسماء المحاضرين او قدد تتغير الاسماء ولكن يمكن عمل جدول باسماء المحاضرين وربطه باسماء المواد العلمية التى سيتم محاضرتها داخل القاعات - كذلك نفس السؤال مطروح للمعمل اختنا الغاليه رجاء اسردى فى مشاركتك القادمه كل ما يخص هذا الموضوع سواء كان من قريب او من بعيد تفصيلا سأقدم المساعده قدر امكانى وحسب توفيق الله لى ولن يتخلى عنكى اساتذتنا الكرام فى هذا الصرح الشامخ فكما عهدناهم اهل الجود والكرم

اتمنى تجد مرادك ان شاء الله كما تتمنى

هذا المرفق يقوم بحذف الجدول بعد الوقت المحدد للعلم لو تم التلاعب بتاريخ الويندوز يتم ايقاف البرنامج جرب ورد على المرفق يحتوى على الاتى جدول T1 وبة حقل Date1 وذلك لتخزين تاريخ اليوم الأول لتشغيل النسخة التجريبية وبعدد العدد المحدد من الايام والذى تدخله انت فى الكود كما تحب فى هذا الكود في حدث عند الفتح للنموذج Private Sub Form_Open(Cancel As Integer) On Error GoTo MyErr: Dim MyFirst As Date Dim MyInDate Dim MyTableName As String MyInDate = DFirst("[Date1]", "[T1]") If Not IsNull(MyInDate) Then MyFirst = MyInDate Else DoCmd.SetWarnings False DoCmd.RunSQL ("INSERT INTO T1 ( Date1 ) SELECT Date();") DoCmd.SetWarnings True MyFirst = Date End If If MyFirst <= Date - 15 Then ' غير الرقم 15 الي اي رقم تريد txt1.Caption = "مضي علي تشغيل البرنامج 15 يوم وسيتم ايقافة" cmdclose.Visible = False Call TableDelete Else If MyFirst > Date Then txt1.Caption = "تم التلاعب بتاريخ الجهاز وسيتم ايقاف البرنامج" cmdclose.Visible = False Call TableDelete End If End If Exit Sub MyErr: If Err.Number = 3078 Then txt1.Caption = "مع السلامة عليك مراجعة صاحب البرنامج" cmdclose.Visible = False Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub لاحظ هذا الكود If MyFirst <= Date - 15 Then هذا عدد الايام الذى تريد فتح البرنامج خلاله انا عملتها لك فى المرفق 1 فقط للتجربه وتقدر تغير التاريخ كما تحب من الكمبيوتر من الويندوز وجرب البرنامج اممممممم وهذا الكود الذي يقوم بعملية حذف الجداول من قاعدة البيانات في حالة انتهاء المدة Function TableDelete() On Error Resume Next Dim MyDb As Database Dim MyTable As TableDef Dim MyTableCount As Integer Set MyDb = Application.CurrentDb MyTableCount = MyDb.TableDefs.Count For i = MyTableCount - 1 To o Step -1 Set MyTable = MyDb.TableDefs(i) MyTableName = MyTable.Name If Left$(MyTableName, 4) <> "Msys" Then MyDb.TableDefs.Delete (MyTableName) Next MyDb.Close End Function نسخة اخرى بصيغة 2000-2003 Demo.rar هذا المرفق 2007-2013 فقط Demo.rar

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

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

بما أن الحاسب استطاع قراءة الفلاشة فلا يوجد مشكلة أما بشأن الفرمتة فلا تؤثر أبدا على عمل البرنامج إن كانت الفرمتة للفلاشة أو للحاسب لا يوجد أي تأثير بما أن الحاسب استطاع قراءة الفلاشة فلا يوجد مشكلة وماذا لو لم يستطع الحاسب قراءة الفلاشة ب اى وضح من الاوضاع ؟

طيب ولو الفلاشة اتحرقت ايه هو الحل وهل لو حدث مشكله فى الفلاشه وتم عمل فورمات هل يتأثر البرنامج ؟!

فى ملف باسم DATA.DBF واضح انه فعلا مش بيشتغل على اكسس 2013 بسس للعلم احنا بنتقدم يعنى المفروض كل الناس تتجه للاحدث لانه مع الوقت القديم راح يتوقف الشغل والدعم عنه تمام انا مش عارف ملاحظ الناس متمسكه باصدارات اقدم ولا اعرف السبب ؟ ياريت لو فى وجهة نظر توضحوها لنا ينوبكم فينا ثواب ليه انتم مصريين على العمل على الاصدرات القديمه ؟ بينما الاصدارات الحديثه تتيح الكثير من الامكانيات التى لا توجد فى نظيرتها القديمه

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

شوف ده مثال شامل وجامع إخفاء واظهار الجداول والكائنات.rar

طيب عاوزين ومحتاجين بيانات للمساعده عدد القاعات عدد المعامل البيانت الثابته والغير متغيره ليتم انشاء الجداول الثابته وربطها بالعلاقات اللازمه