-
Posts
344 -
تاريخ الانضمام
-
تاريخ اخر زياره
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو hanan_ms
-
استكمال وتحديث 1- معالجة التشغيل خاصة التقارير بوضع الاقلاع اكسس مصغر عند ملف اختصار سطح المكتب كود بنموذج الاقلاع 2- عرض التقارير كامل الجدول , الاستعلام , الفلترة بنافذة التقارير 3- اضافة وتحسين بعض الخيارات ... '========( اعتقد عدد السجلات مفتوح ولطباعة بنافذة معاينة قبل الطباعة ونافذة السجلات المستمرة مع تنسيق الشرطي ثابت ومستقر ما توقف على تلريون اتكمل تحميل المرفق https://www.mediafire.com/file/hdhrjlj4t4srt7o/Update_3_Miluon_Record_IN_One_Speed_Read_db_Caption_Filter.rar/file يجب اختيار زر انشاء عشر جداول ثم زر الاتصال ثم زر اضافة بيانات وهمية ثم التشغيل😇 للتجرب الى تحديث التالي مع الاستكمال والمعالجة
-
كملت وبقى سكه داله عامة وكود مصغر Private Sub ActiveXCtl63_Click() '===( مصدر التقسيم من النموذج الحالي) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم , سحب الفلترة من التنموذج الحالي) Call OpenPagedReportWithFilter("D_1", "frm_1", "العملاء", 100, "A7") End Sub Private Sub ActiveXCtl64_Click() '===( مصدر التقسيم من الاستعلام) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم) Call OpenPagedReport("frm_1", Me.db.Caption & "_SQL_Date_1", 100, "A7") End Sub Private Sub ActiveXCtl65_Click() '===( مصدر التقسيم من الاستعلام) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم) Call OpenPagedReport("frm_1", Me.db.Caption & "_SQL_Date_2", 100, "A7") End Sub
- 3 replies
-
- 1
-
-
- شخابيط
- شخابيط وأفكار
- (و14 أكثر)
-
اكملت يعمل بملايين السجلات للعرض التقارير للمعاينة قبل الطباعة مع التقسيم =========================================( @Foksh 🌹☕ 64 bit مع اقل ذاكرة 4 GB والمفترض يكون على القليل 8 GB احسن من 32 يسخن ويحترق اقصد يعطب لا يستوعب الامكانيات 😂 المهم عرفة وين يشتغل ==================================( استاذ @ابو جودي❤️🌹☕ والمهم ملاحظاتك قبل الرفع واستكمال الموضوع الثاني ====================( ممكن اعدل على الكود
- 3 replies
-
- 1
-
-
- شخابيط
- شخابيط وأفكار
- (و14 أكثر)
-
؟! تمة التجربة مرفق يأخذ العربي فقط استخدمة المرفق لعرض معاينة التقرير في النموذج يتحجم ويتغير طبقا للكود فقط هل لديك دالة تقسم بعد الاستعلام او الفلترة الى فلترة لعرض السجلات في التقرير وتعلم ان التقرير لحد معين من السجلات يمكن يعرضها او ينهار ويغلق ؟! , فنقسم كل 5000 الف سجل هل المعلومة صحيحة وهل لديك دالة استاذ @ابو جودي ❤️🌹☕ \ نستفيد من عصير خبرتك 😇 تحميل المرفق https://www.mediafire.com/file/0j7r9h3j0bk8rkw/Report_after_print_In_Form_with_tools_V1.mp4/file
- 3 replies
-
- شخابيط
- شخابيط وأفكار
- (و14 أكثر)
-
تحديث لتجربة معالجة 'على سبيل المثال عند الكود او الدالة Call OptimizeStart { Coding }}; Call OptimizeEnd Option Compare Database Option Explicit Dim ixx As Integer, j As Integer, J1 As Integer ' تعريف المتغير العام لتخزين حالات الاتصال Public GlobalSavedLinks As Collection ' تحرير الذاكرة باستخدام API Private Declare PtrSafe Sub EmptyWorkingSet Lib "psapi" (ByVal hProcess As LongPtr) #If VBA7 And Win64 Then Private Declare PtrSafe Function GetCurrentProcess Lib "kernel32" () As LongPtr Private Declare PtrSafe Function SetProcessWorkingSetSize Lib "kernel32" (ByVal hProcess As LongPtr, ByVal dwMinimumWorkingSetSize As Long, ByVal dwMaximumWorkingSetSize As Long) As Long #Else Private Declare Function GetCurrentProcess Lib "kernel32" () As Long Private Declare Function SetProcessWorkingSetSize Lib "kernel32" (ByVal hProcess As Long, ByVal dwMinimumWorkingSetSize As Long, ByVal dwMaximumWorkingSetSize As Long) As Long #End If ' في قسم التصريحات العامة للوحدة النمطية #If VBA7 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #Else Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Private Sub PauseForUIUpdate(Optional ms As Long = 50) DoEvents Sleep ms DoEvents End Sub Private Sub OptimizeStart() On Error Resume Next ' 1. إيقاف تحديثات واجهة المستخدم Application.Echo False DoCmd.Hourglass True ' عرض مؤشر الانتظار ' 2. إيقاف التحذيرات والرسائل DoCmd.SetWarnings False ' 3. تحسين إعدادات العرض Application.SetOption "Show Status Bar", False Application.SetOption "Show Animations", False ' 4. تعطيل الأحداث المؤقتة للنموذج ' Me.Painting = False ' Me.FastLaserPrinting = True ' Me.ScrollBars = 0 ' تعطيل أشرطة التمرير مؤقتاً ' 5. تحرير الذاكرة Call ClearMemory ' 6. تعطيل تحديث الشاشة للنموذج Me.Repaint End Sub Private Sub OptimizeEnd() On Error Resume Next ' 1. إعادة تفعيل تحديثات واجهة المستخدم Application.Echo True DoCmd.Hourglass False ' 2. إعادة تفعيل التحذيرات DoCmd.SetWarnings True ' 3. استعادة إعدادات العرض Application.SetOption "Show Status Bar", True Application.SetOption "Show Animations", True ' 4. إعادة تفعيل خصائص النموذج ' Me.Painting = True ' Me.FastLaserPrinting = False ' Me.ScrollBars = 2 ' أشرطة التمرير الرأسية ' 5. تحديث النموذج Me.Refresh DoEvents End Sub Private Sub ClearMemory() On Error Resume Next ' طريقة بديلة لتحرير الذاكرة بدون استخدام API Dim db As DAO.Database Set db = CurrentDb ' تحرير ذاكرة الاستعلامات Dim qdf As DAO.QueryDef For Each qdf In db.QueryDefs qdf.Parameters.Refresh Next qdf ' إغلاق كائنات قاعدة البيانات Set qdf = Nothing Set db = Nothing ' تحرير ذاكرة النماذج المفتوحة Dim frm As Form For Each frm In Forms frm.Repaint Next frm End Sub ' دالة مساعدة للتحقق من دعم الخاصية Private Function IsPropertySupported(obj As Object, propName As String) As Boolean On Error Resume Next Dim testVal testVal = CallByName(obj, propName, VbGet) IsPropertySupported = (Err.Number = 0) Err.Clear End Function Private Sub ProcessInChunks() Dim i As Long Dim totalRecords As Long Dim chunkSize As Long totalRecords = 1000 ' عدد السجلات الكلي chunkSize = 100 ' حجم كل جزء Call OptimizeStart For i = 0 To totalRecords Step chunkSize ' معالجة جزء من البيانات ProcessChunk i, i + chunkSize ' تحديث الشاشة بين الحين والآخر If i Mod 200 = 0 Then Me.Repaint DoEvents End If Next i Call OptimizeEnd End Sub Sub ClearMemoryCache() ' محاولة لتحرير الذاكرة Dim i As Long For i = 1 To 100000 ' عملية فارغة لتحفيز تنظيف الذاكرة Next i ' طريقة أخرى لتحرير الذاكرة #If VBA7 And Win64 Then Call SetProcessWorkingSetSize(GetCurrentProcess(), -1, -1) #Else Call SetProcessWorkingSetSize(GetCurrentProcess(), -1, -1) #End If End Sub 1- يجب وضع اختصار سطح المكتب ثم تنقل لاي مكان مع تحديد الخصائص الاختصار الثاني انزال النافذه 2- استكمال انتقال بين القواعد واعادة قائمة المنسدلة .RowSouros 😇 3- والعملية بداية الكود ونهايتة تكون لاكود براميتر او لعدة عمليات استعلام وفلترة وتعديل احجام الادوات تستعمل او ان يكون اجراء المطول 4- انظر لتجربة اسرع تحميل المرفق https://www.mediafire.com/file/1n73xsnmz1l0yk8/Fix_Update_2_Miluon_Record_IN_One_Speed_Read_db_Caption_Filter.rar/file يجب اختيار زر انشاء عشر جداول ثم زر الاتصال ثم زر اضافة بيانات وهمية ثم التشغيل😇 للتجرب الى تحديث التالي مع المعالجة
-
تحديث واستكمال للتوضيح عند عمل نموذج مستمر اعتيادي مع تقيد الحقول بتنشيق الشرطي سيكون وميض وترميش نصف النموضج لكل حركة ( عند الغاء التنسيق الشرطي لا وميض ولا ترميش بملايين السجلات ) واذا استخدمة حقل او حقلين لتنسيق شرطي سوف يكون خفيف في الاسفل والاعلى النموذج وميض وترميش فقدمة لك الحل البديل بلا ترميش وميض والكل تنسيق شرطي مع سرعة التنقل 1- اضافة عرض مباشر 10000 الف سجل سرعة مناسبة مقسم ويعمل مع استعلام العادي ويمكنك التحكم بتعديل عدد السجلات داخل الكود 2- استعلام عادي لعرض التواريخ المنتهية ولم تنتهي في الموجموعات 3- بحث لكافة الجداول المرتبطة عن رقم فريد كرقم المدني القومي وملاحظة عند البحث ستجد عند جدول واحد لان البحث برقم ID متشابهة لجداول المرتبطه 4- استخدام التنسيق الرشرطي Caption 5- اضافة فحص للجداول بتحديد من حقل قائمة جم يشيل 😇 6- مع بعض التصحيحات وتحسينات تحميل المرفق https://www.mediafire.com/file/uoe599ymzy53g0p/Update_2Miluon_Record_IN_One_Speed_Read_db_Caption_Filter.rar/file يجب اختيار زر انشاء عشر جداول ثم زر الاتصال ثم زر اضافة بيانات وهمية ثم التشغيل😇 للتجرب الى تحديث التالي مع المعالجة
-
استكمال 1- اضافة فحص الاتباط 2- فحص وقياس عدد السجلات في الجداول المحلية والشبكة المحلية 3- اضافة 10 جداول مع اضافة بيانات اكثر وهمية الى 1000000 مليون سجل وتقدر تعدل الى 20,000,0000 مليون 4- نافذة الانشاء الجداول والارتباط بحزمة 10 جداول 5- تشغيل وتقسيم والفلترة تم التصحيح 6- اضافة سجلات بتسلسل مع تحديد معيار الحد الاقصى للسجلات لكل جدول مرتبط داخل الكود ============== ناقصة فحص اذا الجدول مرتبط عند التنقل والاضافة بتحديث تحميل المرفق https://www.mediafire.com/file/umnrtj2n6yvijtc/200,000,000_Record_IN_One_Speed_Read_db_Caption_Filter.rar/file يجب اختيار زر انشاء عشر جداول ثم زر الاتصال ثم زر اضافة بيانات وهمية ثم التشغيل😇 للتجرب الى تحديث التالي
-
لما تكون زهقان وداخل تشوف صحابك بيعملوا ايه فى المنتدى
hanan_ms replied to ابو جودي's topic in قسم الأكسيس Access
معالجة بسيطة @ابو جودي❤️🌹☕ ههه سقط الجمل فستأسد الحمل مثال قديم😇 ما اقصد الي في مثال يعمل من غير ترميش ولا وميض مع اضافة واجهة 2 @Moosak ❤️🌹☕جرب تحميل المرفق https://www.mediafire.com/file/53opy2k4ubezau9/Ms_hanan_Test_Desktop_Menu.rar/file -
لما تكون زهقان وداخل تشوف صحابك بيعملوا ايه فى المنتدى
hanan_ms replied to ابو جودي's topic in قسم الأكسيس Access
توضيح ارسالة تظهر قبل التعديل لاستاذ @Foksh الرسال ماتظهر عندي ولا لجهاز ثاني من غير اي خمرشة غير صحيح يا استاذي @ابو جودي ❤️🌹☕ يبليها معالجهة بس والي عندي وجهاز غيري من غير ومضي -
لما تكون زهقان وداخل تشوف صحابك بيعملوا ايه فى المنتدى
hanan_ms replied to ابو جودي's topic in قسم الأكسيس Access
بشارك محاوله لاستاذ @ابو جودي ❤️🌹☕ لعبت بكود @Foksh تحميل المرفق https://www.mediafire.com/file/ljc1tzl04v3dcch/Eye+Ms_hanan.rar/file -
تحديث واستكمال 1- اضافة معايير البحث من 1 الى 5 لكل حقل بحث وقلترة 2- اضافة خيار فقط نتائج البحث والاستعلام فلترة او عرض الكل بموجموعات في الكود بسيط فقط 3-تصحيح الفلترة وعرض الحقول المفلترة + بعض التصحيحات الثانية 😇 4- بعض تحسينات في الواجهة ☕ ... تحميل المرفق https://www.mediafire.com/file/9jtu7ex6u7pshx2/V_4_Speed_Read_db_Caption_Filter.rar/file
-
تحديث واستكمال @منتصر الانسي هل الامور تمام ❤️🌹☕ 1- اضافة تنظيف الذاكرة المؤقته مع اعادة الربط الآلي للجداول 2- تعديل الاقلاع ☕ 3- Form_Name.RowSource اضافة عدد عرض السجلات عن طريق ( كود بسيط لتقيسم ) - عند التجرب اذا كان كامل من غير تقسيم سوف يكون بطىء في الاستجابه من 1 الى 300 الف سجل دفعه كاملة - عند التقسيم كل 100 الف سجل اسرع - عند تقسيم 10 الف سجل سريع ومناسب وانظر الى السرعه عند الوصول الى 300 الف وحتى عند الوصول الى المليون او الملايين من السجلات Link db ScrollBar ( 5 , 6 ) مع تحكم بالاداءة Size 4- اضافة عند نقر المزدوج للحقل تضاف الى حقل الفلترة + تصحيح فواصل السجلات ... تحميل المرفق https://www.mediafire.com/file/zggh0ntu04tkaxb/V_3_Speed_Read_db_Caption_Filter.rar/file
-
تحديث 1- اضافة استخدام عجلة الماوس للتنقل بين السجلات 2- اضافة فرز مع القائمة ====================( @منتصر الانسي ❤️🌹☕ نسيت الغاء زر الاغلاق (X) ☕ عند آخر نافذة كانت للتسجيل الدخول او واجهة الرئيسية الغاء زر الاغلاق تم تصحيح مع رساله خاصة للاغلاق تحميل المرفق https://www.mediafire.com/file/mhpi70zw439r2ug/V_2_Speed_Read_db_Caption_Filter.rar/file
-
اعادة الموضوع صعب انه يفصل الموضوع فحذف 0-حتى لو كان مواصفات الكمبيوتر سيئه ورديئه يعمل بكفاءه من غير وميض وترميش عند تحريك للسجلات الكل Caption مع الفلترة يمكن اسهل طريقة 1- مع الفلترة عرض غير منضم بسيطه من غير DOA , SQL ونوع Caption 2- اضافة آلية وهمية لسجلات 100000 الى تخلص من مساحة التخزين قاعدة ويمكن تغير عدد السجلات في الكود وتجربة 3- تحسين صندوق الرسائل دائما في الامام كل النوافذ 4- جعل الخلفية في الخلف لكل النوافذ ولكن ناقص ===========( اصبحة النافذة مستقرة مع تضخم البيانات لا يأثر ) بناء مختلف فلتره رئيسي وفرعي Caption تجربة لتحسين طريقة عرض السجلات من غير بطىء وتجنب اعادة التحميل الذي يؤثر عند قرب انتهاء مساحة تخزين قاعدة بيانات وتحميلات ويوجد حلول اخرى Function Run Update Link Map all In Folder(1)
-
نموذج خاص لمشروعك @منتصر الانسي ☕🌹❤️ لعمل زر انهاء واغلاق هذا الكود 1- الغاء الكود Private Sub Form_Unload(Cancel As Integer) ' ' منع إغلاق النموذج ' Cancel = True ' HandleCloseAttempt End Sub 2- تعديل كود زر اغلاق وانهاء كما موضع بسطر الكود في المرفق ' تعطيل إمكانية الإغلاق عند التحميل SetAccessCloseAbility False ' تفعيل إمكانية الإغلاق عند التحميل SetAccessCloseAbility True Private Sub Run_Click() On Error GoTo Qut SetAccessCloseAbility True Dim frmXrpt As Integer Dim frmX As Integer Dim rptX As Integer For frmXrpt = 1 To 1 For frmX = 0 To Forms.count - 1 DoCmd.close acForm, Forms(0).name Next frmX For rptX = 0 To Reports.count - 1 DoCmd.close acReport, Reports(0).name Next rptX Next frmXrpt 'DoCmd.Quit acQuitSaveAll SafeExit Exit Sub Qut: MsgBox err.Description End Sub =============================================== :نستفيد من اخفاء الملفات بطريقة المتاهات تذكرة لعبة المتاهات كان عند @Foksh مشكلة ما قدر يحلها المهم توضيح 1- قاعدة فارغة لتشغيل القاعدة واغلاق لماذا بسبب ان اختصار سطح المكتب يعرف فيه مكان قاعدة التشغيل 2- اجعل مجلد القاعدة الفارغه هو اختصار سطح المكتب وعند مجلده اضافة ملفات برقة بيضاء شكلا ووهم ان هذه هي القاعدة دالة التشفير وفك التفير تزيد امان مع تفعيل غفل القواعد بكلمة مرور ودالة العكس والمعالجه المهم جرب طريقة بتشغيل اختصار وهمي On Error GoTo ErrorHandler Dim folderPath As String Dim result As Long Dim fs As String fs = Application.CurrentProject.Path ' تنظيف المسار من أي فواصل أو مسافات زائدة '==================( من غير حقل مفقط مسار قاعدة folderPath = Trim(fs) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' التحقق من وجود المجلد If Dir(folderPath, vbDirectory) = "" Then MsgBox "المجلد غير موجود!", vbExclamation, "خطأ" Exit Sub End If ' إخفاء المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_HIDDEN) If result <> 0 Then Me.lblStatus.Caption = "تم إخفاء المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إخفاء المجلد!" Me.lblStatus.ForeColor = vbRed End If Exit Sub ErrorHandler: Me.lblStatus.Caption = "حدث خطأ: " & err.Description Me.lblStatus.ForeColor = vbRed واذا كان الاستخدام لمفات تتعلق بنظام او القاعدة تكتب سطر سطر من غير & Run من غير جدول من غير حقول Dim Path_X0 As String Dim Path_X1 As String Dim Path_X2 As String Dim Path_X3 As String Dim Path_X4 As String Dim Path_X5 As String Dim Path_X6 As String Dim Path_X8 As String Dim Path_X9 As String Dim Path_X10 As String Dim Path_X11 As String Dim Path_X12 As String Dim Path_X13 As String Dim Path_X14 As String Dim Path_X15 As String Dim Path_X16 As String Dim Path_X17 As String Dim Path_X18 As String Dim Path_X19 As String Dim Path_X20 As String Dim Path_X21 As String Dim Path_X22 As String Dim Path_X23 As String Dim Path_X24 As String Dim Path_X25 As String Dim Path_X26 As String Dim Path_X27 As String Dim Path_X28 As String Dim Path_X29 As String Dim Path_X30 As String Dim Path_X31 As String Dim Path_X32 As String Dim Path_X33 As String Dim Path_X35 As String Dim Path_X36 As String Dim Path_X37 As String Dim Path_X38 As String Dim Path_X39 As String Dim Path_X40 As String Dim Path_X41 As String ' On Error GoTo ErrorHandler Dim folderPath As String Dim result As Long Dim Run As Integer Path_X0 = Application.CurrentProject.Path & "\DDB_Control" Path_X1 = Application.CurrentProject.Path & "\IMG_Company" Path_X2 = Application.CurrentProject.Path & "\IMG_Company_ReP" Path_X3 = Application.CurrentProject.Path & "\IMG_Wallpaper_backgreound" Path_X4 = Application.CurrentProject.Path & "\App_IMG_Wallpaper_backgreound" Path_X5 = Application.CurrentProject.Path & "\IMG_Editor_Menu" Path_X6 = Application.CurrentProject.Path & "\Cantry_IMG" Path_X7 = Application.CurrentProject.Path & "\fonts" Path_X8 = Application.CurrentProject.Path & "\Icon_Button" Path_X9 = Application.CurrentProject.Path & "\Icon_Msgbox" Path_X10 = Application.CurrentProject.Path & "\Sound" Path_X11 = Application.CurrentProject.Path & "\Wallpaper" Path_X12 = Application.CurrentProject.Path & "\Video" Path_X13 = Application.CurrentProject.Path & "\db_BE" Path_X14 = Application.CurrentProject.Path & "\ExE" Path_X15 = Application.CurrentProject.Path & "\IMG_Report" Path_X16 = Application.CurrentProject.Path & "\File_word" Path_X17 = Application.CurrentProject.Path & "\File_Excel" Path_X18 = Application.CurrentProject.Path & "\Book" Path_X19 = Application.CurrentProject.Path & "\File_PowerPoint" Path_X20 = Application.CurrentProject.Path & "\File_Text" Path_X21 = Application.CurrentProject.Path & "\File_Code" Path_X22 = Application.CurrentProject.Path & "\All_InFile_One_Zip_Rar" Path_X23 = Application.CurrentProject.Path & "\ICOn" Path_X24 = Application.CurrentProject.Path & "\Icon_bar_DB" Path_X25 = Application.CurrentProject.Path & "\Icon_bar_Form_Report" Path_X26 = Application.CurrentProject.Path & "\Icon_Button" Path_X27 = Application.CurrentProject.Path & "\icon_Gif" Path_X28 = Application.CurrentProject.Path & "\Icon_Msgbox" Path_X29 = Application.CurrentProject.Path & "\LinkedDB_Backups" Path_X30 = Application.CurrentProject.Path & "\Office_Video" Path_X31 = Application.CurrentProject.Path & "\Qr" Path_X32 = Application.CurrentProject.Path & "\QR_User" Path_X33 = Application.CurrentProject.Path & "\Resources" Path_X34 = Application.CurrentProject.Path & "\World_Cantry" Path_X35 = Application.CurrentProject.Path & "\Gif_IMG" Path_X36 = Application.CurrentProject.Path & "\Fix_Photo" Path_X37 = Application.CurrentProject.Path & "\db_db_db_test_link" Path_X38 = Application.CurrentProject.Path & "\Corrupted_DBs" Path_X39 = Application.CurrentProject.Path & "\Corrupted_Archives" Path_X40 = Application.CurrentProject.Path & "\Change_Dy_Time_All_Table" Path_X41 = Application.CurrentProject.Path & "\Add Fonts.bmp" For Run = 0 To 40 If Run = 0 Then ' تنظيف المسار folderPath = Trim(Path_X0) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 1 Then ' تنظيف المسار folderPath = Trim(Path_X1) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 2 Then ' تنظيف المسار folderPath = Trim(Path_X2) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 3 Then ' تنظيف المسار folderPath = Trim(Path_X3) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 4 Then ' تنظيف المسار folderPath = Trim(Path_X4) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 5 Then ' تنظيف المسار folderPath = Trim(Path_X5) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 6 Then ' تنظيف المسار folderPath = Trim(Path_X6) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 7 Then ' تنظيف المسار folderPath = Trim(Path_X7) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 8 Then ' تنظيف المسار folderPath = Trim(Path_X8) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 9 Then ' تنظيف المسار folderPath = Trim(Path_X9) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 10 Then ' تنظيف المسار folderPath = Trim(Path_X10) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 11 Then ' تنظيف المسار folderPath = Trim(Path_X11) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 12 Then ' تنظيف المسار folderPath = Trim(Path_X12) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 13 Then ' تنظيف المسار folderPath = Trim(Path_X13) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 14 Then ' تنظيف المسار folderPath = Trim(Path_X14) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 15 Then ' تنظيف المسار folderPath = Trim(Path_X15) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 16 Then ' تنظيف المسار folderPath = Trim(Path_X16) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 17 Then ' تنظيف المسار folderPath = Trim(Path_X17) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 18 Then ' تنظيف المسار folderPath = Trim(Path_X18) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 19 Then ' تنظيف المسار folderPath = Trim(Path_X19) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 20 Then ' تنظيف المسار folderPath = Trim(Path_X20) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 21 Then ' تنظيف المسار folderPath = Trim(Path_X21) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 22 Then ' تنظيف المسار folderPath = Trim(Path_X22) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 23 Then ' تنظيف المسار folderPath = Trim(Path_X23) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 24 Then ' تنظيف المسار folderPath = Trim(Path_X24) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 25 Then ' تنظيف المسار folderPath = Trim(Path_X25) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 26 Then ' تنظيف المسار folderPath = Trim(Path_X26) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 27 Then ' تنظيف المسار folderPath = Trim(Path_X27) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 28 Then ' تنظيف المسار folderPath = Trim(Path_X28) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 29 Then ' تنظيف المسار folderPath = Trim(Path_X29) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 30 Then ' تنظيف المسار folderPath = Trim(Path_X30) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 31 Then ' تنظيف المسار folderPath = Trim(Path_X31) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 32 Then ' تنظيف المسار folderPath = Trim(Path_X32) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 33 Then ' تنظيف المسار folderPath = Trim(Path_X33) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 34 Then ' تنظيف المسار folderPath = Trim(Path_X34) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 35 Then ' تنظيف المسار folderPath = Trim(Path_X35) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 36 Then ' تنظيف المسار folderPath = Trim(Path_X36) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 37 Then ' تنظيف المسار folderPath = Trim(Path_X37) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 38 Then ' تنظيف المسار folderPath = Trim(Path_X38) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 39 Then ' تنظيف المسار folderPath = Trim(Path_X39) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 40 Then ' تنظيف المسار folderPath = Trim(Path_X40) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 41 Then ' تنظيف المسار folderPath = Trim(Path_X41) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If Next Exit Sub ErrorHandler: Me.lblStatus.Caption = "حدث خطأ: " & err.Description Me.lblStatus.ForeColor = vbRed End Sub ما رايك في الفكرة 😇 @منتصر الانسي
-
يوجد تفاعل ❤️🌹☕ @منتصر الانسي ميزة الاداءة لا يمكن الاغلاق الى عند نموذج اغلاق او مدير المهام اما Taskbar لايمكن الاغلاق واكملت لك امر مهم لتأمين 1- اخفاء المجلد واظهارة وعند الاخفاء تستطيع النسخ والاستخراج والاتصال بقواعد البيانات مع تحكم اخفاء واظهار المجلد اسهل حماية مبدأ من خلال ضغط زر 2- حفظ علاقات الجدول عند اعادة الربط سوف يقوم بأعادة ربط العلاقات ( المفترض لا يوجد علاقات بعد اعادة الربط تمسح ولكن الدالة تعيد اعادة ربط العلاقات المحفوظة في الجدول بعد اعادة الاتصال ) تحميل الملف 115 kb https://www.mediafire.com/file/ljsw3xtsvpr33z0/SetFormBackColors_v1.5.rar/file
-
تم تصحيح مرفقك واضافة دالة منع اغلاق اكسس وعند Taskbar win @منتصر الانسي جرب المرفق تحميل المرفق https://www.mediafire.com/file/w4ro360p6l47rhp/SetFormBackColors_v1.2.rar/file وما اقدر ارفع في الموقع ============================================================( تجربة لمشروعك ) انسخ الدالة ونموذج start اضافة الى نموذج الاقلاع فتح نموذج ومخفي DoCmd.OpenForm "start", , , , , acHidden
-
تفضل الحل API 1- لا يوجد مشكلة عند التحريك والتقطع حتى لو كان الكمبيوتر رديئ ( الكود داخل النموذج) 2- ( الكود داخل النموذج) حل مشكلة تخمير الكمبيوتر من غير اغلاق ودخول لغفل الويندوز والعودة من غير انهيار اكسس والتجميد وحتى فتح نافذة حفظ اكسس المنهار تحميل https://www.mediafire.com/file/6s6ortc6lnlngy5/Clock+In+Sub+Form+(1).rar/file مشكلة فورم التامير المخفي يعمل بستمرار هنا تسبب في مشكلة الحل تباعد الوقت والعمل عند ساعة = الساعة الحالية ويوم جديد كمعادلة شرطية مع شرط تحقق حالة الجهاز الكمبيوتر والاقلاع يكون minized At set Time 100 or Up 600 Maxmind
-
لان حصل لج لبس بتضارب سياق من موضوع لموضوع آخر اقصد ثاني مثال استاذ @Foksh☕❤️🌹 السلاسل صحيح ولكن كان في موضوع آخر ( سلاسل بناين يبدأ من ثم يغفل بتكرار حلقات وليسة بمسى حلقة تكرارية بختلاف صيغة بنيان للكود او الدالة او الوحدة النمطية او بلغة آخرى كممارسة تعبير لتنفيذ ) وبعض الكلام بطبع غير مفهوم يختص من مستوى معين مع الادراك وهو يقصد شعور المبادر اكملة علية كأنه سلسلة ذرعها سبعون ذراعا فسلكوه .. لا يحض على طعام المسكين ..! لا يأكله الا الخاطئون استاذه @Lamyaa🌹❤️☕☕ لو تسعاديني اشوي بسبب الوقت عندج خبره مثل قلب النصوص وكان خطأ هو اسهل وما ينعمل اقصد مايتسوى اي تركيبة في مكتبة لان صارة الكمبيوترات العملا مغفوله بمحرك الويندوز بلصق اي ملف او افلاشة انا بنيت بعض من مرفقات @Moosak🌹☕ كنت بعدل بنيان بالكامل فحتفظ بعمله اوصلة طبيعي ما اشتغلة بعض المرفقات السابقة بسبب نسيان تحديث المسار للملفات جل من لا يسهو ومالكم لابسين بين الذكر والانثى 😂 استاذه @Lamyaa , استاذ @Foksh , لو تعدلون في المرفق او تعطوني مرفق اكمل عليه المرفق لا تنسون المسكين 😂
-
=============================================( صور + مرفق + فيديو ) Update: 🌹 ما في مساهم بدالة او كود استكمال 1- تحسين مظهر بالترتيب شنو راي @Foksh 2- اضافة نسخة الجدول ببناء جملة كود فورية عند التحديد 2- + اضافة عرض وضع التصميم + جدول + حذف 3- اضافة عرض الجدول المحدد الى وضع الاستعلام لاستخراج جملة الكول كاستنباط ثاني سريع ومختصر 4- تحسن باضافة دوال بوحدة النمطية لعرض رسائل @Moosak ☕🌹😇 - كانت تسبب ببعض التأخير عند الفتح مع زقلله 😂 دالة y_SubTitle As String Dim v_My_Msg_Type As MsgType Dim v_My_Bottns As Bottons Dim v_My_Ar_Eng As language Dim v_My_Auto_Close As Boolean Dim v_My_Close_After_Seconds As Double Public v_My_Response As Response Public IsMsgFormOpen As Boolean '===============================( معالجة ظهور الشاشة ' في قسم التصريحات العامة للنموذج Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hwndLock As LongPtr) As Long Private m_blnFormLoaded As Boolean Private m_colControls As Collection ' دالة رئيسية قابلة للاستدعاء Public Function LoadFormSafely(ByVal strname As String) As String On Error GoTo ErrorHandler Dim strFormName As String ' الحصول على اسم النموذج بطريقة آمنة If Not (Forms(strname) Is Nothing) Then strFormName = Forms(strname).name Else LoadFormSafely = "Error: Not called from a form" Exit Function End If ' تهيئة المجموعة Set m_colControls = New Collection ' تعطيل التحديثات المرئية LockWindowUpdate Application.hWndAccessApp Forms(strname).Painting = False ' تحميل البيانات بدون تأثيرات مرئية If Not RefreshFormDataSilently(strFormName) Then LoadFormSafely = "Error: Failed to refresh data" Exit Function End If ' تمكين التحديثات Forms(strname).Painting = True LockWindowUpdate 0 m_blnFormLoaded = True LoadFormSafely = "Success: Form " & strFormName & " loaded successfully" Exit Function ErrorHandler: ' استعادة الإعدادات في حالة حدوث خطأ If Not m_colControls Is Nothing Then Set m_colControls = Nothing End If LockWindowUpdate 0 If Not (Forms(strname) Is Nothing) Then Forms(strname).Painting = True End If LoadFormSafely = "Error: " & Err.Description End Function ' دالة محسنة لتحديث بيانات النموذج Private Function RefreshFormDataSilently(strFormName As String) As Boolean On Error GoTo ErrorHandler Dim ctl As Control Dim ctlState As Object Dim frm As Form Set frm = Forms(strFormName) ' حفظ حالة العناصر For Each ctl In frm.Controls Set ctlState = CreateObject("Scripting.Dictionary") ctlState.Add "Name", ctl.name ctlState.Add "Enabled", ctl.Enabled ctlState.Add "Locked", ctl.Locked ctlState.Add "Visible", ctl.Visible If TypeOf ctl Is SubForm Then ctlState.Add "SourceObject", ctl.SourceObject End If m_colControls.Add ctlState, ctl.name Next ctl ' تعطيل العناصر مؤقتاً For Each ctl In frm.Controls If Not (TypeOf ctl Is Label) And Not (TypeOf ctl Is Image) Then ctl.Enabled = False ctl.Locked = True If TypeOf ctl Is SubForm Then ctl.SourceObject = "" End If End If Next ctl ' تحديث مصدر البيانات If frm.RecordSource <> "" Then frm.RecordSource = frm.RecordSource End If ' تأخير لضمان الاستقرار Dim t As Single t = Timer Do While Timer < t + 0.2 DoEvents Loop ' استعادة حالة العناصر For Each ctl In frm.Controls If IsInCollection(m_colControls, ctl.name) Then Set ctlState = m_colControls(ctl.name) ctl.Enabled = ctlState("Enabled") ctl.Locked = ctlState("Locked") ctl.Visible = ctlState("Visible") If TypeOf ctl Is SubForm Then ctl.SourceObject = ctlState("SourceObject") End If End If Next ctl RefreshFormDataSilently = True Exit Function ErrorHandler: RefreshFormDataSilently = False End Function ' دالة مساعدة للتحقق من وجود عنصر في المجموعة (تم تصحيح اسمها) Private Function IsInCollection(col As Collection, key As String) As Boolean On Error Resume Next Dim item As Object Set item = col(key) IsInCollection = (Err.Number = 0) On Error GoTo 0 End Function '=======================[Main Function] Public Function MyMsgBox(ByVal strMsg As String, _ Optional Title As String = "", _ Optional SubTitle As String = "", _ Optional Msg_Type As MsgType = 0, _ Optional Bottns As Bottons = 0, _ Optional Ar_Eng As language = 0, _ Optional Auto_Close As Boolean = False, _ Optional Close_After_Seconds As Double = 2) As Response '===========================( Chack IF MSGBOX = Error ms access Dim Msgbox_1 As String Dim MsGbOx_2 As String Dim MsGbOx_3 As String ' Store Values in Variables If Title = "Error Massage !" Then Msgbox_1 = strMsg MsGbOx_2 = Title MsGbOx_3 = SubTitle Else If Title = "Sand Massage !" Then Msgbox_1 = strMsg MsGbOx_2 = Title MsGbOx_3 = SubTitle Else Msgbox_1 = DLookup("[MasgPrtThree]", "[tblMassages]", " [IDMasg] =" & strMsg & " ") MsGbOx_2 = DLookup("[MasgPrtOne]", "[tblMassages]", " [IDMasg] =" & Title & " ") MsGbOx_3 = DLookup("[MasgPrtTow]", "[tblMassages]", " [IDMasg] =" & SubTitle & " ") End If End If v_My_Msg = Msgbox_1 v_My_Title = MsGbOx_2 v_My_SubTitle = MsGbOx_3 v_My_Msg_Type = Msg_Type v_My_Bottns = Bottns v_My_Ar_Eng = Ar_Eng v_My_Auto_Close = Auto_Close v_My_Close_After_Seconds = Close_After_Seconds ' Open MSG Form IsMsgFormOpen = True DoCmd.OpenForm "MyMsgBoxF" Do Until IsMsgFormOpen = False DoEvents Loop ' Return User Response MyMsgBox = My_Response End Function Public Function My_Msg() As String My_Msg = v_My_Msg End Function Public Function My_Title() As String My_Title = v_My_Title End Function Public Function My_SubTitle() As String My_SubTitle = v_My_SubTitle End Function Public Function My_Msg_Type() As Integer My_Msg_Type = v_My_Msg_Type End Function Public Function My_Bottns() As Integer My_Bottns = v_My_Bottns End Function Public Function My_Ar_Eng() As Integer My_Ar_Eng = v_My_Ar_Eng End Function Public Function My_Auto_Close() As Boolean My_Auto_Close = v_My_Auto_Close End Function Public Function My_Close_After_Seconds() As Double My_Close_After_Seconds = v_My_Close_After_Seconds * 1000 End Function Public Function My_Response() As Response My_Response = v_My_Response End Function كود الاستدعاء حدث عند الفتح بسطر واحد LoadFormSafely (Me.Form.name) نتيجة: 7 - اضافة دول واكواد مساعدة 8 +.... والمزيد الشرح المتبقي في الفيديو الجزء الثاني تحميل المرفق 1.8 MB https://www.mediafire.com/file/nu5sfgvf8dgchmz/Update+14-4-2025+Get_Code_SQL_DOA_2025.rar/file
-
اشكرك استاذ @Foksh ☕🌹 مشاركة اللطيفة يكون صحيح حسب سطح مفهومك يحب الفهم الساذج والبسيط والمخارج متفرعة وليس له فهم آخر كما لا يفرق المبدأ ان كان دكتور او دكتورة يهدف للمطورين او المعقدين وهو بسيط للغاية نموذج لا اكثر حاولت الدمج بستيعاب العمل السريع العنوان لا يكفي ؟ !! اعلم يوجد نقص في تركيبة وبناء الجمل جرب حاول ان تكمل ؟! يمكن نصل الى استعياب آخر اقصد ثاني ولا اعلم نظرتك للاستاذي @ابو جودي 🌹❤️☕☕ مفهو استنباط الفهم بالدوال وشرحات
-
من قيمة فقط DlookUp اذاهاب الى سجل جديده جرب اضافة زر في النموذج الرئيسي خارج فرعي DOA اضافة سجل مع الفحص لتكوين Dim Ttb3 As Recordset Dim Key1,key2,key3 Set Ttb3 = CurrentDb.OpenRecordset("اسم_جدولك") Ttb3.AddNew Ttb3![اسم_الحقل] = Key1 'Ttb3![اسم _الحقل] = Key2 Ttb3![اسم _الحقل] = Key3 Ttb3.Update DoEvents الفرعي استخدم تحديد Forms.(اسم_النموذج).form(اسم_النموذج_الفرعي).Requery او استخدم Form_اسم_النموذج_الفرعي.Requery نفترض انشاء مفتاح تسلسل يوجد موضوع لاستاذي @ابو جودي ☕☕❤️🌹 في طريقة اضافة اداة Tools من ActiveX 😇
-
=====================( مرفق وفيديو وصور وبعض الشرح ) برنامج او اداة لبناء جمل SQL , DOA 1- اضافة توقيع للكود 2- اظهار كافة الحقول والمفتاح الاساسي 1-2 3- الاستعلامات اضاهار الحقو والمفتاح الاساسي وتحديد الجدولين بالاسم 1_2 4- اضافة دوال مجال بعد اذن استاذ @Moosak 🌹❤️☕ 5- اضافة مسارات النماذج والتقارير الى الفرعيات 6789... +++ ---------------------------------------------- 6- اضافة شروحات وتستطيع اضافة كود ثم عرضة بسهولة ------------------------------------------------ كان مرفق بأسم Personnel_affairs في احدى مواضيع بنيان الجداول خطأ بسبب تفرقة الخوادم لنك 2 بس طريقة ثانية فكنت بكمل سويت موضوع ثاني Index Tab To TabX ----------------------------------------------------------------------------------------------------------- احتاج دعمكم للاستكمال ليس من الشرط الدخول الى ركام الدوال ابني من المعطيات بناء جملة مثال على الاستخراج SQL ╔════════════════════╗ ║ ███╗ ███╗ ║ ║ ████╗ ████║ ║ ║ ██╔████╔██║s_hanan║ ║ ██║╚██╔╝██║ ║ ║ ██║ ╚═╝ ██║ ║ ╚═══╩═══════╩══╝ On Error GoTo Ops Dim strsql As String strsql = Delete * from DmnFunBldrT WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ") _ & SELECT * FROM [Query_Now] WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ");" CurrentDb.Execute strsql , dbFailOnError Me.Requery '-----------------------------------------------------------------------( For Error Code Only Copy And No Can use Function = Here Error :) X exit_Ops: Exit Sub Ops: MsgBox "حدث خطأ: & Err.Description, vbCritical Resume exit_Ops مثال DOA / \ \ / / \ \ \ _____________ _ |=============|/A\ | | U/ |_____________|_/ \ / \_________/ Dim DB As DAO.Database Dim RS As DAO.Recordset Dim FLD As DAO.Field Dim DBC As DAO.Database Dim RSC As DAO.Recordset Dim FLDC As DAO.Field On Error GoTo ErrorHandler Dim FPath As String FPath = If Dir(FPath) <> " Then Set db = DBEngine.OpenDatabase ( FPath,False, True,;PWD=234344 ) Dim FPath2 As String FPath2 = skjgksgjk kjskgaka If Dir(FPath2) <> " Then Set DBC = DBEngine.OpenDatabase ( FPath2,False, True,;PWD=Forms![Add_Filed=Control]![ST] ) ' فتح Recordset strSQL = "SELECT [FieldName], [FieldType] FROM [Tablet_Now] WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ")" INNER JOIN [Box_INFO_DOA_SQL] ON [DmnFunBldrT].[ID] = [Box_INFO_DOA_SQL].[ID] WHERE SELECT * FROM [Query_Now] WHERE [FieldSize] = #2025/06/09# AND [ConditionType] = #2026/02/02# AND [Form_Index_ID_Table] = DCount("[Dile]","[Deil_Devloper]"," [ID] Is Not Null ") ORDER BY رقم القرار") ' معالجة النتائج ' معالجة الحقل [And_Or] If Not IsNull(rs.Fields![And_Or]) Then rs.Fields![And_Or] = "--اكتب الكود هنا--" End If ' معالجة الحقل [CondCbo] If Not IsNull(rs.Fields![CondCbo]) Then rs.Fields![CondCbo] = "--اكتب الكود هنا--" End If ' معالجة الحقل [DomainTxt] If Not IsNull(rs.Fields![DomainTxt]) Then rs.Fields![DomainTxt] = "--اكتب الكود هنا--" End If ' معالجة الحقل [FieldCbo] If Not IsNull(rs.Fields![FieldCbo]) Then rs.Fields![FieldCbo] = "--اكتب الكود هنا--" End If ' معالجة الحقل [And_Or] من الجدول الثاني If Not IsNull(rs.Fields![And_Or]) Then rs.Fields![And_Or] = "--اكتب الكود هنا--" End If ' معالجة الحقل [DataTypeCbo] من الجدول الثاني If Not IsNull(rs.Fields![DataTypeCbo]) Then rs.Fields![DataTypeCbo] = "--اكتب الكود هنا--" End If ' معالجة الحقل [DomainTxt] من الجدول الثاني If Not IsNull(rs.Fields![DomainTxt]) Then rs.Fields![DomainTxt] = "--اكتب الكود هنا--" End If ' معالجة الحقل [End_Parentheses] من الجدول الثاني If Not IsNull(rs.Fields![End_Parentheses]) Then rs.Fields![End_Parentheses] = "--اكتب الكود هنا--" End If ' معالجة الحقل [FormCbo] من الجدول الثاني If Not IsNull(rs.Fields![FormCbo]) Then rs.Fields![FormCbo] = "--اكتب الكود هنا--" End If =' " & # Forms![Index_ID_Table]![Label25] # & " ' " =' " & Forms![INFO]![k2] & " ' " =' " & Me.k2 & " ' " rs.Filde!ConditionType = Forms![Add_Filed=Control]![ST] rs.Filde!ConditionType = Forms![Add_Where_SQL]![ST] rs.Filde!ConditionType = Forms![Index_ID_Table]![] rs.Filde!ConditionType = Forms![Index_ID_Table]![Label25] rs.Filde!ConditionType = Me.ST rs.Filde!FieldName = Forms![Index_ID_Table]![Label25] rs.Filde!FieldType = Me.Label25 rs.Filde!IsKey <> me.RT rs.Filde!mkan_scan = Forms![INFO]![k2] rs.Filde!mkan_scan = Me.k2 Rs.Close db.Close RSC.Close DBC.Close Set RS = Nothing Set DB = Nothing Set RSC = Nothing Set DBC = Nothing Else MsgBox قاعدة البيانات غير موجوده End IF Else MsgBox قاعدة البيانات غير موجوده End IF Exit Sub ErrorHandler: If Err.Number =3031 then MsgBox " كلمت المرور خاطأ تأكد من كلمت المرور للاتصال بقاعدة بيانات خارجية ") MsgBox "حدث خطأ: " & Err.Description, vbCritical Resume Next ' تنظيف الموارد If Not rs Is Nothing Then If rs.State = 1 Then rs.Close Set rs = Nothing End If Set db = Nothing اعتذر عدم اكماله ضغوطات وحاله صحيه تسمم غذائي ☕ وفي مميزات لم اشرحا استكمل البقية في فيديوا تحميل المرفق 1.8 MB https://www.mediafire.com/file/0fyiynev0lkldi2/Get_Code_SQL_DOA_2025.rar/file