Foksh

وعليكم السلام ورحمة الله وبركاته ,,, سؤال سريع ، يوجد فترتين ( أولى و ثانية ) صحيح ؟؟ اشرح لنا موضوع الفترتين ..

وعليكم السلام ورحمة الله وبركاته 🤗.. جرب هذا التعديل أخي الكريم :- Private Sub Workbook_Open() Dim filePath As String ' المسار الكامل للملف filePath = "C:\Program Files\new\officeteam.txt" ' تحقق من وجود الملف If Dir(filePath) = "" Then MsgBox "ليس لديك الاذن في الاستخدام, يرجى التواصل مع مالك النظام . تنبيه.", vbCritical ThisWorkbook.Close SaveChanges:=False End If End Sub المشكلة أن الكود الذي كتبته يحتوي على خطأ في طريقة تحديد المسار ، حيث إنك قمت بدمج filePath مع requiredFile مرتين .

أخي الكريم ، هل الملف يعمل معك بشكل سليم أولاً ؟؟؟ فعادة تطبيق واتس اب يغير في طريقة الربط والارسال في تحديثاته على حد علمي . فهل قمت بتجربة الفكرة أولاً ؟؟؟؟ طبعاً الخلل ليس في الفكرة وطريقة التنفيذ ، وإنما كما أخبرتك هي في تحديثات شركة Meta ( و Whatsapp أحد منتجاتها حالياً )

تفضل :- القاعدة 2.zip

أسعدك الله وبارك الله بك ، وهنأك بعلمه الذي علمك إياه .. وأتمنى لك المزيد من التوفيق والتألق بأعمالك المميزة التي نريد رؤيتها قريباً شكراً لك

وإياكم أستاذنا الكبير ، ونسأل الله أن نكون عند حسن ظنهم . وأن نتعلم من علمكم الذي وهبكم الله إياه . الله يبارك فيك أخي الحبيب .. نتمنى أن نراكم بجانبنا يوماً ما حبيبي مهندس عمر .. الله يبارك فيك ، ونتمنى لكم المضي بجانبنا

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

حبيبي زياد ربي يسعدك .. شكراً لك على تهنئتك

هههه ، انا لو كنت عاوز أفتح الباب للفضول أكتر ، كان اقترحت الفكرة دي مثلاً :- Private Sub Form_Load() On Error Resume Next Me.Alborg.Visible = (Time() <= #3:00:00 PM#) On Error GoTo 0 End Sub أما لو عاوز نفتحها بحري ونتوسع في الحديث ، فممكن نعمل الآتي :- في مديول لوحده كده بدون ما حد يزعجه :- Option Compare Database Option Explicit Public Enum ControlVisibility visible = 0 Hidden = 1 ErrorState = 2 End Enum Public Enum EventType Information = 0 Warning = 1 [Error] = 2 End Enum Public Function ShouldShowControl(Optional targetTime As Date = #3:00:00 PM#) As Boolean ShouldShowControl = (Time() < targetTime) End Function Public Function SetControlVisibility(frm As Form, ctlName As String, _ Optional targetTime As Date = #3:00:00 PM#) As ControlVisibility On Error GoTo ErrorHandler Dim ctl As Control Set ctl = frm.Controls(ctlName) If ctl Is Nothing Then SetControlVisibility = ErrorState Exit Function End If Dim visible As Boolean visible = ShouldShowControl(targetTime) ctl.visible = visible SetControlVisibility = IIf(visible, visible, Hidden) Exit Function ErrorHandler: LogEvent "Error setting visibility for " & ctlName, EventType.Error SetControlVisibility = ErrorState End Function Public Sub LogEvent(message As String, Optional msgType As EventType = EventType.Information) #If DEBUG_MODE Then Debug.Print Format(Now, "yyyy-mm-dd hh:mm:ss") & " [TimeBasedControl] " & _ Choose(msgType + 1, "INFO", "WARN", "ERR") & ": " & message #End If End Sub طبعاً هنقدر نستدعي الفكرة دي بشكل متعدد لأكثر من وقت وأكتر من هدف 😋 :- 1️⃣ الطريقة البسيطة الأولى :- Private Sub Form_Load() UpdateControlVisibility #7:00:00 PM# End Sub Private Sub Form_Timer() Static lastUpdate As Date If Now > lastUpdate + TimeSerial(0, 0, 30) Then UpdateControlVisibility #7:00:00 PM# 'هنا طبعاً الوقت اللي عايزه lastUpdate = Now End If End Sub Private Sub UpdateControlVisibility(targetTime As Date) Dim result As ControlVisibility result = SetControlVisibility(Me, "SendBtn1", targetTime) 'باللي انت عايزه SendBtn1 بدل اسم الزر If result = ErrorState Then MsgBox "فشل تحديث العنصر", vbExclamation + vbMsgBoxRight, "" End If End Sub 2️⃣ الطريقة الثانية :- Private mTargetTime As Date Private Sub Form_Load() mTargetTime = #8:45:00 PM# UpdateTimeDisplay UpdateControlVisibility End Sub Private Sub cmdSetTime_Click() Dim newTime As String newTime = InputBox("أدخل الوقت المطلوب (HH:MM:SS AM/PM)", "تعيين الوقت", Format(mTargetTime, "hh:mm:ss AM/PM")) If newTime <> "" Then If IsDate(newTime) Then mTargetTime = CDate(newTime) UpdateTimeDisplay UpdateControlVisibility Else MsgBox "تنسيق الوقت غير صالح", vbExclamation + vbMsgBoxRight, "خطأ" End If End If End Sub Private Sub UpdateTimeDisplay() lblCurrentTime.Caption = "الوقت الحالي: " & Format(Time, "hh:mm:ss AM/PM") & vbCrLf & _ "الوقت المستهدف: " & Format(mTargetTime, "hh:mm:ss AM/PM") End Sub Private Sub Form_Timer() Static lastUpdate As Date If Now > lastUpdate + TimeSerial(0, 0, 1) Then btnEvening.SetFocus UpdateTimeDisplay UpdateControlVisibility lastUpdate = Now End If End Sub Private Sub UpdateControlVisibility() Dim result As ControlVisibility result = SetControlVisibility(Me, "SendBtn1", mTargetTime) If result = ErrorState Then LogEvent "فشل تحديث عنصر التحكم", EventType.Error End If End Sub 3️⃣ الطريقة الثالثة ، وسأكتفي بدون ما نتوسع أكتر من كده 😅 :- Private Type ControlTimeSettings ControlName As String ShowBeforeTime As Date ShowAfterTime As Date End Type Private mControlSettings() As ControlTimeSettings Private Sub Form_Load() ReDim mControlSettings(2) With mControlSettings(0) .ControlName = "btnMorning" .ShowBeforeTime = #12:00:00 PM# .ShowAfterTime = #12:00:00 AM# End With With mControlSettings(1) .ControlName = "btnAfternoon" .ShowBeforeTime = #6:00:00 PM# .ShowAfterTime = #12:00:00 PM# End With With mControlSettings(2) .ControlName = "btnEvening" .ShowBeforeTime = #11:59:59 PM# .ShowAfterTime = #6:00:00 PM# End With UpdateControlsVisibility End Sub Private Sub Form_Timer() Static lastUpdate As Date If Now > lastUpdate + TimeSerial(0, 0, 30) Then UpdateControlsVisibility lastUpdate = Now End If End Sub Private Sub UpdateControlsVisibility() Dim i As Integer Dim currentTime As Date Dim shouldBeVisible As Boolean Dim result As ControlVisibility currentTime = Time() For i = LBound(mControlSettings) To UBound(mControlSettings) With mControlSettings(i) If .ShowAfterTime < .ShowBeforeTime Then shouldBeVisible = (currentTime >= .ShowAfterTime And currentTime < .ShowBeforeTime) Else shouldBeVisible = (currentTime >= .ShowAfterTime Or currentTime < .ShowBeforeTime) End If result = SetControlVisibility(Me, .ControlName, IIf(shouldBeVisible, #12:00:00 AM#, #11:59:59 PM#)) If result = ErrorState Then LogEvent "فشل تحديث عنصر التحكم: " & .ControlName, EventType.Error End If End With Next i End Sub Control Visibility.accdb

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

الترقية وسام شرف أضعه على صدري ، وكلماتكم زادتني سعادة وحرصاً على تقديم الأفضل دائماً . تقديري واحترامي لشخصكم الكريم و لكل من مرّ وبارك

وعليكم السلام ورحمة الله وبركاته .. جرب هذا التعديل أخي الكريم رصيد بنــــك الكويت.xlsx

جرب هذا التعديل أخي الكريم :- Sub Observer222() Dim ws As Worksheet Dim lastRowObservers As Long, lastRowCommittees As Long, lastCol As Long Dim maxObserversPerCommittee As Integer, attempts As Integer Dim row As Long, col As Long, observerRow As Long Dim observerID As Variant, isValid As Boolean Dim startTime As Double, retryCount As Integer Const maxAttempts As Integer = 200 Const password As String = "0" Const sheetName As String = "Sheet1" On Error GoTo ErrorHandler If Application.InputBox("أدخل كلمة المرور", "تسجيل الدخول") <> password Then MsgBox "كلمة المرور غير صحيحة", vbExclamation, "خطأ" Exit Sub End If startTime = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set ws = ThisWorkbook.Worksheets(sheetName) ws.Unprotect password lastRowObservers = ws.Cells(ws.Rows.Count, 2).End(xlUp).row lastRowCommittees = ws.Cells(ws.Rows.Count, 3).End(xlUp).row lastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column If lastCol >= 4 Then ws.Range(ws.Cells(3, 4), ws.Cells(lastRowCommittees, lastCol)).ClearContents End If For retryCount = 1 To 3 Dim emptyCells As Integer emptyCells = 0 For row = 3 To lastRowCommittees For col = 4 To lastCol If ws.Cells(row, col).Value = "" Then attempts = 0 isValid = False Do While attempts < maxAttempts And Not isValid attempts = attempts + 1 observerRow = Application.RandBetween(3, lastRowObservers) observerID = ws.Cells(observerRow, 2).Value If Not IsEmpty(observerID) Then If Application.CountIf(ws.Range(ws.Cells(row, 4), ws.Cells(row, col - 1)), observerID) = 0 And _ Application.CountIf(ws.Range(ws.Cells(3, col), ws.Cells(row - 1, col)), observerID) = 0 Then isValid = True End If End If Loop If isValid Then ws.Cells(row, col).Value = observerID Else emptyCells = emptyCells + 1 End If End If Next col Next row If emptyCells = 0 Then Exit For Next retryCount For row = 3 To lastRowCommittees For col = 4 To lastCol If ws.Cells(row, col).Value = "" Then For observerRow = 3 To lastRowObservers observerID = ws.Cells(observerRow, 2).Value If Not IsEmpty(observerID) Then If Application.CountIf(ws.Range(ws.Cells(row, 4), ws.Cells(row, col - 1)), observerID) = 0 Then ws.Cells(row, col).Value = observerID Exit For End If End If Next observerRow End If Next col Next row CleanExit: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True ws.Protect password Dim emptyCount As Integer emptyCount = Application.CountBlank(ws.Range(ws.Cells(3, 4), ws.Cells(lastRowCommittees, lastCol))) If emptyCount > 0 Then MsgBox "تم التوزيع مع وجود " & emptyCount & " قيم فارغة بسبب عدم توفر ملاحظين متاحين", vbExclamation + vbMsgBoxRight, "تنبيه" Else MsgBox "تم التوزيع بنجاح", vbInformation + vbMsgBoxRight, "تم" End If Exit Sub ErrorHandler: MsgBox " : حدث خطأ" & Err.Description, vbCritical + vbMsgBoxRight, "خطأ" Resume CleanExit End Sub

وعليكم السلام ورحمة الله وبركاته .. ارفق لنا مثالك لرؤية كيف قمت بتأسيس نموذج البحث ، وما مصدره وما مصدر النموذج الفرعي ..

ولا يهمك أخي الكريم .. طيب جرب هذه الدالة ، وتستطيع وضعها في مديول عام اذا أردت .. Public Sub UpdateBooksToLost() Dim db As DAO.Database Dim rs As DAO.Recordset Dim maxGard As Long Set db = CurrentDb maxGard = Nz(DMax("No_Gard", "T_Gard"), 0) Set rs = db.OpenRecordset("SELECT * FROM [جدول تسجيل الكتب] WHERE [CaseBook] = 'موجود'", dbOpenDynaset) If Not rs.EOF Then rs.MoveFirst Do While Not rs.EOF rs.Edit rs!CaseBook = "فاقد" rs![G N] = maxGard rs.Update rs.MoveNext Loop End If rs.Close Set rs = Nothing Set db = Nothing MsgBox "تم تحديث الكتب إلى الحالة 'فاقد' وتعيين رقم الجرد بنجاح", vbInformation + vbMsgBoxRight, "" End Sub واستدعيها في أي زر من خلال UpdateBooksToLost فقط .

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

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

حاول بهذه الدالة في زر جديد كاختبار باستدعاء الدالة UpdateBooksConditional في حدث عند النقر .. Private Sub UpdateBooksConditional() Dim rsBooks As DAO.Recordset Dim maxGN As Long Dim counter As Long Dim db As DAO.Database Set db = CurrentDb() maxGN = DMax("No_Gard", "T_Gard") Set rsBooks = db.OpenRecordset( _ "SELECT * FROM [جدول تسجيل الكتب] " & _ "WHERE CaseBook = 'موجود'", dbOpenDynaset) Do Until rsBooks.EOF rsBooks.Edit rsBooks![G N] = maxGN rsBooks!CaseBook = "فاقد" rsBooks.Update counter = counter + 1 rsBooks.MoveNext Loop MsgBox "تم تحديث " & counter & " سجلات", vbInformation rsBooks.Close Set rsBooks = Nothing End Sub

وعليكم السلام وحمة الله وبركاته ,, هلا شاركتنا بكود التوزيع الذي يقوم بالتوزيع ؟؟؟

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

بهذا الشكل ، سيكون علينا جلب أكبر قيمة للحقل G N في جدولك ، ثم تحديث قيم سجلاته بشرطين إما كاملة اذا لم يتم تحديد قيم محددة ، أو للقيم التي تم تحديدها برقمين ( من - إلى ) صحيح ؟؟ اذا كان ما فهمته صحيحاً ، فسيتم تعديل الاستعلام في كود الزر بالشكل التالي :- Private Sub أمر8_Click() If MsgBox("أنت على وشك تحديث حالة جميع الكتب باليومية من كتب موجودة إلى كتب فاقد " & vbCrLf & _ "لتأكيد الأمر أضغط موافق ، ولإلغائه أضغط إلغاء", _ vbInformation + vbOKCancel + vbMsgBoxRight, _ " تأكيد تنفيذ الأمر ") = vbOK Then DoCmd.SetWarnings False Dim maxGN As Variant Dim filter As String If IsNull(Forms!F_GardBooks!text) Or IsNull(Forms!F_GardBooks!text2) Then filter = "[CaseBook]='موجود'" Else filter = "[CaseBook]='موجود' AND searinumber BETWEEN " & Forms!F_GardBooks!text & " AND " & Forms!F_GardBooks!text2 End If maxGN = DMax("[G N]", "[جدول تسجيل الكتب]", filter) If Not IsNull(maxGN) Then DoCmd.RunSQL "UPDATE [جدول تسجيل الكتب] SET CaseBook = 'فاقد' " & _ "WHERE [CaseBook]='موجود' AND [G N]=" & maxGN & ";" End If DoCmd.SetWarnings True End If MsgBox "تم تحديث البيانات بنجاح والحمد لله" End Sub أما من خلال استعلام SQL فلم أفلح في ضبط الأمور لوجود شرطين أو أكثر ، لذا قد يكون هناك حل يعتمد على استعلام مبني على استعلام آخر ، بحيث :- 1. انشاء استعلام جديد ولنفترض باسم qry_GetMaxGN_Conditional علشان نحصل على أعلى قيمة للحقل G N و ( مع أو بدون ) الشرط الثاني وهو تحديد قيمة لكتب محددة ... SELECT MAX([G N]) AS MaxGN FROM [جدول تسجيل الكتب] WHERE CaseBook = 'موجود' AND ( ([Forms]![F_GardBooks]![text] IS NULL OR [Forms]![F_GardBooks]![text2] IS NULL) OR (searinumber BETWEEN [Forms]![F_GardBooks]![text] AND [Forms]![F_GardBooks]![text2]) ); 2. ننشء استعلام التحديث الذي سيتم التحديث للسجلات من خلاله بناءً على السجلات التي حققت شرط الإستعلام السابق :- UPDATE [جدول تسجيل الكتب] SET CaseBook = 'فاقد' WHERE [G N] = (SELECT MaxGN FROM qry_GetMaxGN_Conditional) AND CaseBook = 'موجود'; ولنفترض ان اسمه سيكون على سبيل المثال qry_UpdateCaseBook . ومن خلال زر يتم استدعاؤه بالشكل التالي :- DoCmd.SetWarnings False DoCmd.OpenQuery "qry_UpdateCaseBook" DoCmd.SetWarnings True ملفك بالتجربتين :- القاعدة.mdb

وعليكم السلام ورحمة الله وبركاته .. أخي الكريم بداية أهلا وسهلا بحضرتك معنا في المنتدى . ونرجو أن تجد ما تبحث عنه دائماً وبسرعة . ولتحقيق ذلك هناك أمور علينا توضيحها لك لتحصل على جواب وحل لطلبك ومشكلتك بأسرع وقت ، منها :- 1. إرفاق ملف بسيط يوضح المشكلة الآن بالنسبة لمشكلتك ، أولا إذا كان التقرير مبني على استعلام ، فتستطيع ذلك باستعمال الدالة NZ للحقل المحدد على النحو التالي :- Nz(Grade, "غ") بالإفتراض أن اسم الحقل الأصلي = Grade على سبيل المثال . وهناك عدة طرق ولكن هذا يعتمد على بنية التقرير ، فإذا صعب الأمر عليك ، أرفق لنا التقرير مع مصدره كمثال للتطبيق .

جميل جداً ، ومشاركة ذكية أيضاً .. مع العلم وإنه وإن كان قد لا يستوجب أخذ هذه النقطة بالحسبان ، وهي عدم دعم الفترات التي تمتد بعد منتصف الليل (من 10 مساءً إلى 2 صباحاً مثلاً) على سبيل المثال طبعاً وليس للحصر ..... وطبعاً الإفتراض دوماً أن first_time < last_time لا يخدم النقطة السابقة ( وكما أشرت قد تكون غير ضرورية من الأساس 😅 ) طبعاً لا ينقص تعليقي من فكرة الأستاذ موسى شيئاً .

لا عاش من يتعبك اعتذر منك على هذا القصور Database3.zip

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