كل الانشطه

بارك الله فيك هو دا المطلوب

وعليكم السلام ورحمة الله وبركاته .. جرب هذا التعديل أخي الكريم رصيد بنــــك الكويت.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

الملف المرسل في مشاركة سابقة ممتاز و يعمل بكفاءة و يوزع عدد 2 ملاحظين في كل لجنة برجاء تجربتة و كتابة ملاحظاتك. قمت بتعديل عدد اللجان و الملاحظين ليتوافق مع اللجان عندك توزيع الملاحظين .xlsm

@kanory بارك الله فيك شكراً جزيلاً

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

ولا يهمك أخي الكريم .. طيب جرب هذه الدالة ، وتستطيع وضعها في مديول عام اذا أردت .. 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 فقط .

المقصود ان لكل ملاحظ مسلسل يتم التوزيع من خلال مسلسلة لتسهيل التوزيع بدلا من الاسماء في العمود A والعمود B يمثل ارقام اللجان

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

الف . الف . مبروك @Ahmos تستاهل ... ومزيد من الابداع

@Moosak أخي الكريم، شكراً جزيلاً آمين بارك الله فيك وزادك من فضله ونفع بك وعفا عنك وعافاك @ابوخليل أخي الكريم، شكراً جزيلاً آمين اللهم تقبل أسئل الله العلي القدير أن ييسر لك الخير حيث كان ورزقك علماً نافعاً ينتفع به @Foksh أخي الكريم، شكراً جزيلاً بارك الله فيك، متشكر علي الكلام الجميل ده نفع الله بك وبعلمك وزادك من فضله @محمد طاهر عرفه الأستاذ الفاضل بارك الله فيك، شكراً جزيلاً أسعدكم الله جميعاً وبارك فيكم ورزقكم علماً نافعاً ينتفع به وجمعني بكم علي خير في جنات النعيم رفقة النبيين والصديقين والشهداء والصالحين وحسن أولئك رفيقا

الف . الف . مبرك اخي @Foksh يستاهل من ضحى بوقته وجهده وعلمه للاعضاء ... مزيد من التألق

الف مبروك اخي العزيز فادي .. وأهلا بك بين اخوانك

الف مبروك🌻 واهلا بك أخي فادي في فريق الموقع

السلام عليكم ورحمة الله وبركاته 🌹 بكل فخر وسعادة، تتقدم إدارة منتديات أوفيسنا وكافة أعضائها الكرام بأحرّ التهاني والتبريكات للأخ العزيز فادي @Foksh بمناسبة ترقيته إلى درجة مشرف 👏🎖️ لقد أثبت حضورك وجهودك الملحوظة في دعم الأعضاء وتقديم الفائدة باستمرار، وكان لعطائك بصمة واضحة في رُقي المنتدى وتطوره 📈💡 ✨ نبارك لك هذه الترقية المستحقة، ونتمنى لك كل التوفيق والنجاح في مهامك الجديدة ضمن كوكبة الإشراف في فريق الموقع 🌟 🌟 أهلاً وسهلاً بك في فريق أوفيسنا، واثقين بأنك ستواصل تميزك وتألقك بإذن الله 🌈 مع أطيب التحيات والتقدير، إدارة منتديات أوفيسنا 💼🌟

ما المقصود بعدد الملاحظين حيث الأرقام في العمود متسلسلة؟ هل عدد اللجان المقصود منه رقم اللجنة أم إجمالي اللجان التي سيتم توزيع الملاحظين عليه. كلما كانت المعطيات واضحة كلما كانت النتائج أفض.

الف ميروك 💐

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

مسائكم خير وسعادة وافراح ان شاء الله هذا برنامج مرسل واتساب من عمل الأستاذ أبو خليل جزاه الله خير أحتاج اضافة نموذج يكون عمله يرسل لكل اسم صوره مختلفه عن الاسم الثاني sendwatsWebAll.rar

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

مبروك التشريف .. والانضمام الى كوكبة الخبراء .. تستاهل اكثر زادك الله علما .. ووفقك وسددك

للاسف يعطي عند التنفيذ ويمسح ارقام الملاحظين انظر الى الصورتين

مبارك عليك المسمى أخي @Ahmos 🙂 وهو ليس عليك بجديد .. ومبارك علينا انظمامك لهذه القافلة المباركة .. 🌹 جعلك الله عطاء لا ينضب 🙂🤲

عندما يكون العدد كبير يمكن التحكم في الشروط و لكن الواقع غير ذلك فيكون أهم شرط هو التساوي قدر الأمكان أما دخول نفس اللجان فيتم التحكم فيها يدويا . جرب الملف المرفق بعد تعديل الكود كود (1).xlsm

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