اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

Moosak

أوفيسنا
  • Posts

    1,871
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    50

كل منشورات العضو Moosak

  1. أين وضعت أنت هذه المعادلة ؟ هل هي في الجدول؟ أم الاستعلام؟ أم النموذج؟ أم في الكود ؟
  2. كبداية إن شاء الله ووضع القاعدة الرئيسية لموضوع التوزيع ،، 🙂 قمت بطلب عمل التوزيع حسب الشروط المذكورة من موقع الذكاء الاصطناعي .. فكان هذا جوابه : --------------------------------------------------------------------------------------------------------------------- التحدي الذي واجهته في طلبك هو معقد نوعًا ما ويتطلب تحليلًا دقيقًا وتنفيذًا متقنًا. للأسف، لا يمكنني تقديم الكود الكامل والنهائي هنا بسبب تعقيد المطلوب. ومع ذلك، يمكنني تقديم نمط عام لكيفية تنفيذ هذا التحدي باستخدام VBA في Microsoft Access. ستحتاج إلى تخصيص هذا النمط وفقًا لاحتياجاتك وبنية قاعدة البيانات الخاصة بك. Sub DistributeLessons() Dim startDate As Date Dim endDate As Date Dim currentWeek As Integer Dim weekStartDate As Date Dim weekEndDate As Date Dim studentRS As Recordset Dim teacherRS As Recordset Dim lessonRS As Recordset Dim vacationRS As Recordset ' Set start date and end date startDate = #8/1/2023# endDate = #8/31/2023# ' Set up recordsets for students, teachers, lessons, and vacations Set studentRS = CurrentDb.OpenRecordset("Tbl_Students") Set teacherRS = CurrentDb.OpenRecordset("Tbl_Teachers") Set lessonRS = CurrentDb.OpenRecordset("Tbl_Lessons") Set vacationRS = CurrentDb.OpenRecordset("Tbl_Vacations") ' Loop through the weeks in the month currentWeek = 1 weekStartDate = startDate Do While weekStartDate <= endDate weekEndDate = DateAdd("d", 6, weekStartDate) ' Assuming Sunday is the last day of the week ' Loop through each student studentRS.MoveFirst Do While Not studentRS.EOF ' Check if the student has lessons left for the week Dim lessonsLeft As Integer lessonsLeft = 2 ' Loop through each teacher teacherRS.MoveFirst Do While Not teacherRS.EOF ' Check if the teacher is on vacation for any day in the week Dim isOnVacation As Boolean isOnVacation = False vacationRS.MoveFirst Do While Not vacationRS.EOF If vacationRS!TeacherID = teacherRS!TeachersID And _ vacationRS!StartDateVacation <= weekEndDate And _ vacationRS!EndDateVacation >= weekStartDate Then isOnVacation = True Exit Do End If vacationRS.MoveNext Loop ' If the teacher is not on vacation, assign lessons If Not isOnVacation Then Dim lessonsAssigned As Integer lessonsAssigned = 0 ' Assign lessons to the teacher for the week ' Here you'll need to implement the logic for distributing lessons ' while respecting the constraints (group matching, max 2 lessons per student per week, etc.) ' Update the lessonsAssigned and lessonsLeft counters lessonsLeft = lessonsLeft - lessonsAssigned If lessonsLeft <= 0 Then Exit Do End If teacherRS.MoveNext Loop studentRS.MoveNext Loop ' Move to the next week weekStartDate = DateAdd("d", 7, weekStartDate) currentWeek = currentWeek + 1 Loop ' Close recordsets studentRS.Close teacherRS.Close lessonRS.Close vacationRS.Close End Sub يرجى مراجعة وتخصيص الكود أعلاه وفقًا لهيكل قاعدة البيانات الخاصة بك ومتطلباتك الدقيقة. الجزء الأكثر تعقيدًا هو توزيع الدروس بناءً على الشروط المذكورة، وهذا يتطلب تطوير الخوارزمية الملائمة لذلك. إذا واجهتك أي مشكلة خلال عملية التنفيذ، فلا تتردد في طرح الأسئلة.
  3. أهلا بك أخي @حسان12 🙂 تكرما في المرات القادمة أكتب عنوان واضح ومعبر عن مضمون المشاركة .. إتباعا لقواعد المشاركة في المنتدى 🙂 أما بخصوص سؤالك الثاني فطلبك موجود هنا :
  4. ضع أمر Requery لمربع [القيمة] في حدث [عند التغيير] لمربع [الكمية] 🙂
  5. وعليكم السلام ورحمة الله وبركاته.. فعلا أنا استمتعت بقراءة السؤال 😄 مثال ونموذج يحتذى به في طريقة عرض الطلب 👍🏼🙂 وربما ترتيبك لخطوات التحقق في السؤال سيسهل التطبيق للإخوة إن شاء الله ..
  6. هل تم حل مسألتك الأولى ؟؟ وماهي رسالة الخطأ التي تظهر لك ؟
  7. نعم توجد طريقة سهلة .. وهي تحويل الكود لدالة عامة يمكن استخدامها لأكثر من حقل في نفس الوقت .. وهذه هي صيغة الدالة : Function LockField() If InStr(1, Screen.ActiveControl.Value, "Word") > 0 Then Screen.ActiveControl.Locked = True Else Screen.ActiveControl.Locked = False End If End Function ثم تقوم بتحديد جميع الحقول التي ستطبق عليها الكود .. وتذهب لحدث عند التركيذ وتكتب اسم الدالة هكذا : = LockField() كما في الصورة :
  8. نعم استخدم هذا الكود في حدث عند التركيز للحقل المطلوب : If InStr(1, Me.TextBoxName, "Word") > 0 Then Me.TextBoxName.Locked = True Else Me.TextBoxName.Locked = False End If
  9. هذا هو الكود كاملا .. ربما لم تنسخه بأكمله في برنامجك : #If VBA7 Or Win64 Then Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal ncode As LongPtr, ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As LongPtr #Else Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook as long, ByVal ncode as long, ByVal wParam as long, lParam As Any) as long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) as long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA"(ByVal idHook As LongPtr, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As LongPtr) As LongPtr Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook as long) as long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg as long, ByVal nIDDlgItem as long, ByVal wMsg as long, ByVal wParam as long, ByVal lParam as long) as long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd as long, ByVal lpClassName As String, ByVal nMaxCount as long) as long Private Declare Function GetCurrentThreadId Lib "kernel32" () as long #End If 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 #If VBA7 Or Win64 Then Private hHook As LongPtr #Else Private hHook As Long #End If Public Function NewProc(ByVal lngCode As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Dim RetVal Dim strClassName As String Dim lngBuffer As LongPtr If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, Optional YPos, Optional HelpFile, Optional Context) As String On Error GoTo ExitProperly Dim lngModHwnd As LongPtr Dim lngThreadID As LongPtr lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook ExitProperly: UnhookWindowsHookEx hHook End Function
  10. أخي رضوان @رضوان الجماعي 🙂 أقترح عليك فتح موضوع جديد طازج لكي تأخذ الفكرة حقها من الإهتمام ولفت الإنتباه .. 🙂
  11. @ابوخليل نعم الملف لا يفتح في الإصدارات 64 بت .. 🙂
  12. وعليكم السلام ورحمة الله وبركاته أخي رضوان 🙂 على نهج مصمم البرنامج كتبت لك دالة ترجع لك رقم المستوى للمستخدم الحالي : يمكنك من خلالها تحديد ما هي الأوامر التي تريد أن تعطيها للبرنامج بناءا على مستوى المستخدم الحالي .. مثال : PasswordLogin_RC4_v5.6 (1).accdb
  13. تفضل 🙂 DLookUp("[المسافة]";"[Table1]";"[city1] ='"& [Forms]![Form1]![city1] &"' And [city2] ='"& [Forms]![Form1]![city2] &"' ") test.rar
  14. وعليكم السلام ورحمة الله وبركاته 🙂 أخي @ابو فتحى .. أرفق الكود الذي تستخدمة للإرسال ..
  15. أحسنت وبارك الله فيك باش مهندس @أ / محمد صالح .. 🌹😊 إضافة جميلة جدا للموضوع والمنتدى .. جعلها الله شفيعة لك يوم الحساب 🙂 مقترح : هل يمكن ضم المشاركات في البحث ؟ لأن الكثير من العناوين لا تدل على محتواها .. والمشاركات تحتوي على الكثير من الدرر وأغلب الفوائد موجودة فيها .
  16. وعليكم السلام ورحمة الله الله وبركاته 🙂 باستخدام دالة Sleep نفسها المستخدمة للإنتظار في كود الواتسأب ضع هذه الأسطر من ضمن كود الإرسال لديك ( يفضل أن يكون تحت جملة For مباشرة ) : Dim W As Long ' المتغير يعد الأشخاص الذين تم الإرسال لهم If W = 10 Then ' حدد عدد الذين تريد الإنتظار بعدهم Sleep 15000 ' مدة الإنتظار (كل ألف يساوي ثانية) W = 1 Else W = W + 1 End If وهذا مثال للتجربة : Sub SendToWhatsApp() Dim x As Integer For x = 1 To 50 Dim W As Long ' المتغير يعد الأشخاص الذين تم الإرسال لهم If W = 10 Then ' حدد عدد الذين تريد الإنتظار بعدهم Debug.Print "================================(إنتظار)" Sleep 15000 ' مدة الإنتظار (كل ألف يساوي ثانية) W = 1 Else W = W + 1 End If ' هنا كود إرسال الواتسأب Debug.Print "جار الإرسال للمستخدم رقم: ", x Sleep 500 DoEvents Next x End Sub والنتيجة :
  17. والثالثة : أن تضيف حقل من نوع (نعم/لا) وتجعل هذا السجل (نعم) وتستثنيه من الحذف عند التفريغ .. 🙂
  18. شكر لك أخي @kanory بالفعل هناك تحديث قادم بإذن الله 🙂 .. وهذه صورة تشويقية .. وسأذكر المميزات الجديدة في حينها إن شاء الله ..😊 وربما يصعب إدراج النماذج الفرعية هنا لأن المكان صاير زحمة 😅🖐🏼️
  19. وعليكم السلام ورحة الله وبركاته 🙂 1- أكمل الدالة .. لأنك حاط اسم العميل في النموذج الفرعي ستظهر لك أسماء النماذج الفرعية فقط .. اختر اسم النموذج الفرعي 2 - يجب إضافة هذا السطر يدويا لكي يتم الوصول لحقل رقم العميل . 3- إضغط على زر فحص التعديلات ( يجب أن يكون النموذج مفتوح لترى النتيجة مباشرة ) 4- هنا ستظهر النتيجة الدالة كاملة حسب المعطيات (نفس اللتي في الصورة) : DSum("[المتحصل من العميل]","[customer account sub dollar]","[اسم العميل] ='"& [Forms]![customer_account_$22]![customer_account_main $].FORM![Customer_Name] &"'")
  20. أخي عمر جرب تنزيل هذا التطبيق في هاتفك الأندرويد .. يقوم بنفس العمل 🙂 https://play.google.com/store/apps/details?id=com.poe.android&pli=1
  21. افتح البرنامج بالضغط على زر الشفت shift هذا وظيفته تكون بعدما يتم تقسيم البرنامج .. 🙂
×
×
  • اضف...

Important Information