hanan_ms

لان حصل لج لبس بتضارب سياق من موضوع لموضوع آخر اقصد ثاني مثال استاذ @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

=============================================( صور + مرفق + فيديو ) Update: 🌹 استاذي @ابو جودي ❤️🌹☕☕ التمسة طلبك ولتنفيذ بدون عوار راس ونظامي استاذ @Foksh ❤️🌹 وين رياك برمجة اقصد دوال متقدمة 1- ادارة قواعد بتعين كلمت مرور او الغاء كلمة المرور وحتى لم تكن لها كلمت مرور من الاصل الكل دفعة واحده بضغطة زر 2- ادارة النسخ الاحتياطية اخذ كل النسخ لكل نسخة داخل كل ملفات مع اختيار التصفية بالعدد المطلوب ويحذف القديم 3- قياس سعات التخزين بحديد للملفات مع سعة التخزين المتوفرة بالقرص الصلب او وحدة التخزين 4- انشاء حسابات وضافة بضغطة زر 5- اضافة تسمية النسخة اذا وشكة على الانتهاء تكتب بداية التاريخ الى نهاية التاريخ على سبيل المثال 2025 -2030 6- اضافة شريط متقدم للقياس عند ادارة القواعد والنسخ الاحتياطية تحميل المرفق https://www.mediafire.com/file/w5f2l1aajprsybg/Update_V1-8_Sys_DB_BackUP_One_Click_Ms_Access.rar/file

مشارك مع الاستاذ @Foksh❤️🌹☕ مشاركة للفرز المتتالي ولكن بطريقة مختلفة ويفضل فصل قاعدة بيانات ADODB.Recordest * بتمرير اسم الجدول ثم اسماء الحقول فقط @اشرف السيد يوسف عرض التقرير هل هو صحيح (( تصميم التقرير )) 1-الاسم تقرير فرعي 1- المحافظة التاريخ ملاحضة 2- الفرعي قابل النمو والتقلص والكل الصف مجموعة صح! او العكس المحافظة وفرعي اسمائهم مشكلتك ما حددة الوظيفه للفهم ADODB_Recordset_Rpt_Az_F1ToF0.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 هل توجد ملاحظات ؟ تحديث متقدم 1- تحسين المظهر Classes 2- تصحيح اضافة ايام العطل الرسمية 3- اضافة استخراج تاريخ dd\mm\YYYY او mm\dd\YYYYY 4-اضافة الوقت وتاريخ لكليهما الميــــلادي والهجــــــري او فقط تواريخ 5- اضافة التحكم بقائمة التخصيصي لتحديد ايام العطل في الاسبوح نقصد ايام الراحة لاي يوم او ايام الرياحة في الاسبوع + غفل الاسبوع $ 6- اضافة الوقت JRClock داخل التقويم JRCalender 7 - تصحيحات عامة للمخرجات نص من غير .Text MB 1,722 اقل من السابق MB 1,782 ! تحميل المرفق ميديا فير https://www.mediafire.com/file/10wstr8w0761kpj/Update_JRCalenderClock_2025_Ms_Access.rar/file

اشكرك على رأيك @غريب طرابلس لكل لغة ولها عيوب ونقط ضعف وبيدك استعمال آمن وتكلفة ممتازة افضل من هدر المال وارتفاع الاشتركات للبحث عن ثغرات وشاش اقصد على حسب الامكانيات العميل والي يطلب هذا الطلب غالب ان تكون شركة ولها فروع للتحصيل او حكومي بنطاق واسع وكليهما حسب نوع الخدمة ونطاق ويفضلون الآمن SH.. بنطور الاكسس جرب النافذه كامل الشاشة والعناصر كما هي اما بخصوص الدالة كل من طرق بستخدامها وسابق تعديل كان الريبن شريط الاكسس تشطيف وتعامل مع هذه الدالة استاذي @ابو جودي ☕❤️🌹 وبتحجيم الشاشة والعناصر والقياس واساتذه اخرى وحتى الاجنبي فدالة الي فوق افضلهم

استاذ @ابو جودي ❤️🌹☕☕ هي اضافة قواعد من سنة الى وصول السنة حتى لو وصلة 10 سنوات حسب الادخال والي نسيتة اضافة تسمية للانشاء قواعد اخترة ابصطها 😂وانت استاذي ما تقصر بسرط الدوال اتوقع عندك ملاحظة او نموذج للتأسيس يعني اصدمني بدالة استاذي بس جرب المرفق الا نازم وضع التصميم

=============================================( صور + مرفق + فيديو ) Update: 🌹 1- ادخال التقويم بالرصد الرسمي مع بعض التحسينات 2- قائمة الرصد الاجازات 3- ادخال الوقت مميز تجربة ممتعة ☕ JRCalenderClock_2025_Ms_Access.rar

=============================================( صور + مرفق + فيديو ) Update: 🌹 طلب استاذ @Foksh❤️🌹☕ تبيني اسويه عداد بيلر 😂 دورك ورني ابداعاتك استاذي @ابو جودي❤️🌹☕☕ اعتذر الآخر جاهز فيه كل الدول جاهز بس شوي تعديل وبرفع بس ضم مشروعك مسأل الواجهة تسجيل دخول والصلاحيات والتحكم جاهزه لو تعطني نظرة على هذا المرفق من غير طحن كل الدوال بدالة لو بدالة مفصلين بضم استكمال مع طلب المساعده 1- متوفر فيه معلومات وشرح طريقة انشاء شبكة محلية طيارة عن طريق كمبيوترك 3 خطوات 2- تعديل الدول لاحتساب الرسم البياني متقدم 3- اضافة تحديدث واختيار بدور 4- اضافة مكان مخصص للشبكة المحلية بالاول تسجل اسم الكمبيوترك الي بشبكة جهازك باول زر 2- اضافة تلقائية سريعة 6- حذف الملفات بالشبكة الاحتياطية مع خيار اخذ نسخة احتياطية 7- تجربة تسجيل دخول متقدم تعرف حجم القاعدة وتربط وتشتغل في الشبكة المحلية 8- ادوات اعادت الاتصال بشبكة المحلية مع غفلها او تنشيطها 9- رموز اسفل البار في حالة الاتصال بالانترنت مع حالة اتصالك الى جهاز آخر مو حاسوبكاقصد عند حاسوب اخر 10 - جعل بار في الاعلى بحرك بسيطه 11- استخدام القائم في الواجهة الفكرة اخذ اي مشروع في اكسس وحوله الى قواعد بيانات الميزه عند اعادة الربط يربط الكل في القاعد ويصفي القديم من غير كتابة اسم الجداول مع فحص متقدم سويت مذكرة مع قاعدة شوف الفيديو بسرعة يعني برنامج افراح وصالات او محاسبة كمل اشوي واستخدم معاها البرنامج او الاداة خل كل كمبيوتر في حالة المسئول نسخ كل القواعد لي ملفة ويربط فيهم التحديث بضغطة زر في طرق اسهل من غير تشعيب بعض من التصحيحات واستكمال ========================================= الاستكمال قريبا V1.6_GiveMe_File_Out_Size_File.rar

لا تنسى عند فتح يتأكد من آخر تاريخ مسجل اكبر من تاريخ اليوم '===================================== لو تختصر اضافة حقل نعم \ لا اسهل بكثير بضغطة زر تحديث يرجع الوضع السدادا وتحدد الاشهر الي تبيها ومن اجمالي عدد حقل الصح نعم \ لا يبين عدد الشهر مع ذكر الحسابات البينكية تحويل وشيكات او قبض في الصندوق نافذه صغيره ومرتبة !مع ازالة حركة نزول النموذج السرعة وعلى فكر التاريخ يكتب مو تختار فكر بوقت سرعة الادخال وتواريخ مسبقة ليش تفتح التقويم التقويم حق التنسيق او المستشارين متخذين القرار ويحتاجه منسق الاعمال تقول متصل ومندوب بتنظيم التوقيت وغفل اليوم وترحيل المواعيد ================================ المشكلة بتصميم استعلام والكود المستخدم ماله شغل اصدار اكسس

تفضل استاذ @Foksh 🌹❤️☕ تحديث انت ما تحب المعقدين 1- اضافة سحب ملف باسم بالمسار بعدد ملفات الفرعية في الملف وحجم الملف 2- اضافة استخراجهم برسالة 3- تغير طريقة مستعرض الملفات 4- الرسم البياني بشكل الدائرة - فقط جدول سهل للغاية حاضرين باي خدمات V1.4_GiveMe_File_Out_Size_File.rar

اهلا اهلا استاذي @ابو جودي ❤️🌹☕☕ اهلا استاذ @Foksh❤️🌹☕ استاذ @Foksh بدال تخلي الرسم ثلاثي من اقصى 2 جيجا الى حجم الملف برسم دائرة بيانية امخلينها عداد موتر الله يهداكم 😂 الافضل يكون الشغل اكثر احترافية تحديث بتطبيق اداة MultiPage (AcitveX) متقدم لا تنسى تفعيل المكتبات 1- اختيار ملف مره وحده الى تيرابايت 2- اختيار مجلد الى تيرابايت 3- اكتب المسار لو كان بالجدول الى تيرابايت 4- ادوات تحكم وتصحيح الخطأ عند اعادة التصميم MultiPage ينقصني تعديل لقراءة حجم المجلد مو الملف بص على الكود بسيط وجاري التعقيد Option Compare Database Option Explicit '_______________( المتغيرات العامة )___________________ Private LastProcessedPage As String ' لتتبع آخر تبويب تم التعامل معه Private LastClickTime As Date ' لتحديد وقت آخر ضغط Private Const CLICK_DELAY As Integer = 1 ' الحد الأدنى بين الضغطات (بالثواني) ' ثوابت الألوان Private Const TAB_NORMAL As Long = 15921906 ' رمادي فاتح Private Const TAB_ACTIVE As Long = 16777215 ' أبيض Private Const TAB_TEXT As Long = 0 ' أسود Private Const TAB_HOVER As Long = 14483455 ' أزرق فاتح Private Const BG_COLOR As Long = 12566463 ' أزرق غامق للخلفية Private Sub B0_Click() On Error GoTo ErrorHandler If IsNull(Me.B0) Or Me.B0 = "" Then ShowUserMessage "حدد نوع الخط ...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .FontName = Me.B0 End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub CH1_Click() On Error GoTo ErrorHandler If IsNull(Me.CH1) Or Me.CH1 = "" Then ShowUserMessage "حدد النمط من القائمة...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 If Me.CH1 = 1 Then UpdateActiveTab .Style = Me.CH1 '=======( Buttons1 ) - ( Tabs0 ) - (None) -" Else .Style = Me.CH1 '=======( Buttons1 ) - ( Tabs0 ) - (None) -" End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Ch2_Click() On Error GoTo ErrorHandler If IsNull(Me.Ch2) Or Me.Ch2 = "" Then ShowUserMessage "حدد تغير الاتجاهات...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .TabOrientation = Me.Ch2 '====(0)Top - (1)Buttm - (2)Right - (3)Left - " End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Ch3_Click() On Error GoTo ErrorHandler If IsNull(Me.Ch3) Or Me.Ch3 = "" Then ShowUserMessage "حدد النمط من القائمة...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .SpecialEffect = Me.Ch3 End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Color_2_Click() On Error GoTo ErrorHandler Me.cx3 = DialogColor(Me.cx3.BackColor) If IsNull(Me.cx3) Or Me.cx3 = "" Then Else Me.pack2.BackColor = Me.cx3 With Me.MultiPage3 .ForeColor = Me.cx3 End With End If Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub color_Click() On Error GoTo ErrorHandler Me.cx2 = DialogColor(Me.cx2.BackColor) If IsNull(Me.cx2) Or Me.cx2 = "" Then Else Me.Pack.BackColor = Me.cx2 End If With Me.MultiPage3 .BackColor = Me.cx2 'COLOR_NORMAL End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub Form_Close() '__________( اغلاق والحفظ تهيئة القائمة )____________ Call Menu_X_Click End Sub Private Sub Form_Load() ' تهيئة القيم الأولية LastProcessedPage = "" Call Menu_X_Click End Sub Private Sub Form_Open(Cancel As Integer) Me.h = Me.InsideHeight Me.w = Me.InsideWidth Me.z1 = 0 Me.z2 = 0 Me.z3 = 0 End Sub Private Sub Menu_X_Click() On Error Resume Next With Me.MultiPage3 '.Parent = Page '.Caption = btnCaption ' .Left = Left ' .Top = Top .Width = 2000 .Height = 7665 .FontName = "Segoe UI" .FontBold = True .Font.size = 10 '===================( Nurmail ) .BackColor = rgb(260, 260, 260) 'COLOR_NORMAL .ForeColor = rgb(0, 0, 0) ' black Color .BorderColor = rgb(220, 220, 220) .BorderShade = rgb(180, 180, 180) ' .BackColor = RGB(51, 153, 255) ' .ForeColor = RGB(149, 179, 215) .TabOrientation = 3 '====(0)Top - (1)Buttm - (2)Right - (3)Left - " .Style = 0 '=======( Buttons1 ) - ( Tabs0 ) - (None) -" .MultiRow = True .TabFixedWidth = 80 .TabFixedHeight = 20 .BorderStyle = fmBorderStyleSingle '.SpecialEffect = fmSpecialEffectFlat .SpecialEffect = fmSpecialEffectEtched .MousePointer = fmMousePointerCustom '.BackStyle = fmBackStyleOpaque '.OnClick = "[Event Procedure]" Exit Sub End With End Sub Private Sub MultiPage3_Change() On Error GoTo ErrorHandler '_________________( الحدث الرئيسي )__________________ Dim currentPage As String ' currentPage = Me.MultiPage3.SelectedItem.Caption currentPage = CleanPageName(Me.MultiPage3.SelectedItem.Caption) '______________( التحقق من التكرار )___________ If currentPage = LastProcessedPage Then Exit Sub If currentPage = LastProcessedPage And _ DateDiff("s", LastClickTime, Now) < CLICK_DELAY Then Exit Sub End If '__________( معالجة الأوامر حسب الصفحة )________ Select Case currentPage '________________________________________________________________________ Case "MsgboxTest1" MsgBox "جاري فتح لوحة العملاء...", vbInformation, Date ' Call X '________________________________________________________________________ Case "MsgboxTest2" ShowUserMessage "جاري تحميل قائمة المنتجات...", vbInformation '________________________________________________________________________ Case "selected_Folder" Dim DL As Office.fileDialog Dim sizeInfo As String Set DL = Application.fileDialog(msoFileDialogFolderPicker) If DL.Show Then Call GetSelected_Path_DatabaseSize(DL.SelectedItems(1)) sizeInfo = GetSelected_Path_DatabaseSize(DL.SelectedItems(1)) Me.size = sizeInfo End If '________________________________________________________________________ Case "Selected_File_db" Dim sizeInfox As String Dim path_x As String Dim DLX As Office.fileDialog Set DLX = Application.fileDialog(msoFileDialogFilePicker) If DLX.Show Then path_x = DLX.SelectedItems(1) Call GetSelected_Path_DatabaseSize(path_x) sizeInfox = GetSelected_Path_DatabaseSize(path_x) Me.F5 = sizeInfox End If Case Else ' يمكنك إضافة صفحات أخرى هنا End Select '____( تحديث السجل الأخير )____ LastProcessedPage = currentPage Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub sz_Click() On Error GoTo ErrorHandler If IsNull(Me.sz) Or Me.sz = "" Then ShowUserMessage "حدد حجم الخط ...( فارغ )", vbCritical Exit Sub End If With Me.MultiPage3 .Font.size = Me.sz End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub ' Private Sub sizedb_Click() ' Dim sizeInfo As String ' ' Call GetSelectedDatabaseSize ' ' sizeInfo = GetSelectedDatabaseSize() ' Me.size = sizeInfo ' ' End Sub Private Sub xxx_Click() Dim sizeInfo As String If IsNull(Me.path) Or Me.path = "" Then MsgBox " الرجاء كتابة مسار قاعدة البيانات ", vbExclamation Exit Sub End If Call GetSelected_Path_DatabaseSize(Me.path) sizeInfo = GetSelected_Path_DatabaseSize(Me.path) Me.size_path = sizeInfo End Sub Private Sub UpdateActiveTab() On Error Resume Next Dim i As Integer With Me.MultiPage3 ' إعادة تعيين جميع التبويبات For i = 0 To .Pages.Count - 1 If Me.MultiPage3.SelectedItem.Caption = "page1" Then .BackColor = TAB_ACTIVE .ForeColor = rgb(0, 0, 139) ' أزرق غامق .FontBold = True Else .Pages(i).BackColor = TAB_NORMAL .Pages(i).ForeColor = TAB_TEXT .Pages(i).FontBold = False End If Next i ' تمييز التبويب النشط If .Pages.Count > 0 Then With .Pages(.Value) .BackColor = TAB_ACTIVE .ForeColor = rgb(0, 0, 139) ' أزرق غامق .FontBold = True End With End If End With End Sub '_______________( الدوال المساعدة )_________________ Private Function CleanPageName(rawName As String) As String ' تنظيف اسم الصفحة من أي إضافات CleanPageName = Replace(Replace(rawName, "\", ""), "/", "") End Function Private Sub ShowUserMessage(msg As String, iconType As VbMsgBoxStyle) ' عرض رسائل المستخدم بشكل منسق Dim msgText As String msgText = "System Notification" & vbCrLf & String(50, "?") & vbCrLf & msg MsgBox msgText, iconType + vbSystemModal, "نظام الإدارة" End Sub Private Sub X() Dim i As Integer With Me.MultiPage3 For i = 0 To .Pages.Count - 1 If Me.MultiPage3.SelectedItem.Index = i Then ' .BackColor = TAB_ACTIVE .ForeColor = rgb(0, 0, 139) ' أزرق غامق .FontBold = True Else ' .Pages(i).BackColor = TAB_NORMAL .Pages(i).ForeColor = TAB_TEXT .Pages(i).FontBold = False End If Next i End With End Sub Private Sub z1_Click() On Error GoTo ErrorHandler With Me.MultiPage3 If Me.z1 = 0 Then .FontUnderline = False Else .FontUnderline = True End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub z2_Click() On Error GoTo ErrorHandler With Me.MultiPage3 If Me.z2 = 0 Then .FontItalic = False Else .FontItalic = True End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub Private Sub z3_Click() On Error GoTo ErrorHandler With Me.MultiPage3 If Me.z3 = 0 Then .FontBold = False Else .FontBold = True End If End With Exit Sub ErrorHandler: MsgBox "حدث الخطأ: " & Err.Description, vbCritical, "رقم الخطأ" End Sub V1_GiveMe_File_Out_Size_File.rar