# نبي نتناقش ي موضوع اكواد vba اكسل
### Participant
نبي نتناقش ي موضوع اكواد vba اكسل
### Auto Claude (Claude Sonnet 5.5)
موقفي: VBA ما زال خيارًا عمليًا ومفيدًا لأتمتة Excel على سطح المكتب، لكنه ليس الخيار الأفضل دائمًا، والأمر يعتمد على نوع الشغل.
**أسباب أدعم فيها VBA:**
1. **سهل البداية:** مسجّل الماكرو يخليك تتعلم من أكواد مولّدة جاهزة، وهذا مفيد لغير المبرمجين.
2. **وصول كامل لنموذج كائنات Excel:** الأوراق والجداول والمخططات والجداول المحورية والتنسيق، وكلها تتحكم فيها مباشرة.
3. **يعمل محليًا بدون بنية تحتية:** ملف واحد يكفي، بدون خوادم أو تراخيص إضافية.
4. **عندك قاعدة ضخمة من الأكواد الجاهزة:** كثير من الشركات تعتمد عليها، ومعرفة VBA تساعدك تصلح وتطوّر الموجود.
**حدوده (من معرفتي، ولم أتحقق منها في هذا الرد):**
- لا يعمل في Excel على الويب، ودعمه في الجوال محدود.
- الماكرو في الملفات المحمّلة من الإنترنت يُحجب افتراضيًا في إصدارات Office الحديثة، وهذا يضايق مشاركة الملفات.
- صعب الصيانة والاختبار مقارنة بلغات حديثة، وبيئة التطوير قديمة.
- بدائل مثل Office Scripts وPython في Excel وPower Query تغطي بعض الحالات، لكن لا أعرف حاليًا مدى تغطيتها لكل ما يقدر عليه VBA، وأحتاج أتحقق قبل ما أجزم.
باختصار: لو شغلك داخل Excel على الكمبيوتر وتحتاج أتمتة سريعة، فـVBA مناسب. أما لو تحتاج تعاونًا سحابيًا أو تحليل بيانات كبير، فالبدائل أولى.
عشان نركّز النقاش: وش هدفك بالضبط؟ تتعلم VBA من الصفر، أو عندك كود يحتاج إصلاح، أو تقارن بينه وبين بدائله؟
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
موقفي هنا هو **محامي الشيطان**: سأتعمد الاعتراض على الحلول التي تبدو صحيحة أو مريحة في VBA، خصوصًا عندما يكون الحل يعمل الآن لكنه ضعيف هندسيًا أو سيسبب مشاكل لاحقًا.
في نقاش أكواد **Excel VBA** سأركز على نقاط أرى أنها أهم من مجرد «الكود اشتغل»:
- **هل الكود مصمم صح أم فقط يؤدي المهمة؟** قد يعمل 100%، ومع ذلك يكون مليئًا بالتكرار، مرتبطًا بالفورم مباشرة، أو صعب التعديل مستقبلًا.
- **الأداء:** سأعترض على الحلقات وقراءة الخلايا واحدة واحدة عندما توجد طريقة أسرع باستخدام Arrays أو Dictionaries أو المعالجة الجماعية.
- **الاعتمادية:** نجاح الكود مع البيانات الحالية لا يعني أنه سيتحمل صفوفًا فارغة، بيانات مكررة، تغيّر ترتيب الأعمدة، أو ملفًا مستوردًا بتنسيق مختلف.
- **هيكلة المشروع:** خصوصًا في برامجك المبنية على UserForms، سأدافع عن فصل **الواجهة عن منطق المعالجة وعن البيانات** عندما يكون ذلك مبررًا، وسأعارض الفصل الزائد إذا كان سيحوّل برنامجًا بسيطًا إلى مشروع معقد بلا فائدة.
- **التطوير مقابل إعادة البناء:** لن أفترض أن «الكود الاحترافي» يعني إعادة كتابة كل شيء. أحيانًا إصلاح موضعي مدروس أفضل من هدم نظام مستقر وإعادة بنائه.
والأهم: إذا قال Auto Claude إن طريقة معينة هي الأفضل، فلن أعارضه لمجرد المعارضة؛ سأحاول كسر منطقه بحالات واقعية. وإذا صمد الحل أمام الاعتراضات، فهذا دليل أقوى على أنه الحل المناسب.
أنا جاهز لأول قضية VBA.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
أبرز نقطة خلاف محتملة: هل الأفضل في مشروع VBA فعلي **تحسين الكود القائم تدريجيًا** أم أن تراكم الترابط بين الفورم والمنطق والبيانات يجعل **إعادة الهيكلة** أوفر وأضمن على المدى الطويل؟
Auto Claude: ما المعايير العملية التي تستخدمها لتقرر أن كود VBA قائمًا تجاوز مرحلة «الإصلاح» وأصبح يحتاج إعادة هيكلة؟
### Auto Claude (Claude Sonnet 5.5)
موقفي: الإصلاح التدريجي هو الافتراضي، والهيكلة الكاملة تحتاج مبررًا واضحًا. وهذه معاييري العملية لتجاوز مرحلة الإصلاح:
1. **كلفة التعديل تتصاعد:** كل تغيير بسيط (عمود جديد مثلًا) يلمس أكثر من 3 أماكن في الكود، أو يكسر أشياء لا علاقة لها به.
2. **تكرار نفس الخطأ:** نفس الباغ يرجع بعد كل إصلاح لأن المنطق منسوخ في أكثر من مكان.
3. **تعذّر الاختبار:** ما تقدر تشغّل جزءًا من المعالجة بدون فتح الفورم وإدخال بيانات يدويًا.
4. **مخاطر العمل:** الملف مهم ماليًا أو تشغّله فرق متعددة، فالباغ مكلف.
5. **تعدد المستخدمين:** إن كان مستخدم واحد وكود ثابت، فالهيكلة غالبًا ترف.
وأقترح مسارًا وسطًا: لا تعيد الكتابة، بل **استخرج المنطق من أحداث الفورم إلى دوال مستقلة كلما لمست جزءًا**. هذا يعطيك معظم فائدة الهيكلة بدون مخاطرة الهدم.
نقطة لم تُطرح بعد: وجود أي اختبارات أو ملف نموذجي للمخرجات الصحيحة. بدونه، إعادة الهيكلة مقامرة لأنك لن تعرف هل تغيّر السلوك.
Chatty GPT 5.6: هل ترى معيارًا آخر يجعل الهدم أوفر من التدرّج؟
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة المهمة: غياب اختبارات مرجعية يجعل أي إعادة هيكلة مخاطرة حتى لو كان التصميم الحالي ضعيفًا.
Chatty GPT 5.6: كيف تبني **شبكة أمان واختبارات عملية داخل مشروع VBA قديم** قبل فصل الفورم عن المنطق، خصوصًا إذا لم توجد اختبارات أصلًا؟
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
أتفق مع Auto Claude في نقطة أساسية: **إعادة هيكلة مشروع VBA قديم بلا مرجع يثبت أن النتائج لم تتغير أخطر من بقاء بعض سوء التصميم مؤقتًا.** لكنني أخالفه في اعتبار الاختبارات التقليدية شرطًا قبل البدء؛ في VBA يمكن بناء شبكة أمان عملية أولًا ثم التحرك تدريجيًا.
قبل لمس الهيكلة أبنيها هكذا:
1. **لقطة مرجعية للواقع:** نأخذ ملفات تشغيل حقيقية تمثل الحالات الطبيعية والحالات الشاذة، ونحفظ المخرجات الصحيحة الحالية.
2. **اختبارات Regression بسيطة:** نشغّل نفس المدخلات قبل وبعد كل تعديل، ثم نقارن النتائج آليًا: القيم، عدد السجلات، الأسماء، التواريخ، والحالات المهمة.
3. **فصل الاختبار عن الفورم:** إذا كان `CommandButton_Click` ينفذ 200 سطر، لا أعيد تصميمه فورًا. أبدأ باستخراج جزء صغير يمكن استدعاؤه مباشرة وتمرير مدخلاته إليه.
4. **Assertions داخل بيئة التطوير:** يمكن استخدام `Debug.Assert` للتحقق من افتراضات مهمة أثناء التطوير؛ مثل أن عدد السجلات الناتجة يساوي العدد المتوقع.
5. **سجل مقارنة:** أي اختلاف بين النسخة القديمة والجديدة يجب تفسيره قبل اعتماد التعديل؛ ليس كل اختلاف خطأ، فقد يكشف الاختبار خطأً قديمًا أصلًا.
والشرط الإضافي الذي قد يغيّر قراري بالكامل: **الاعتماد على الحالة العامة Global State**. إذا كانت الإجراءات تعتمد بكثافة على `ActiveSheet` و`Selection` ومتغيرات عامة وحالة الفورم، فلن أبدأ بفصل معماري كبير؛ سأزيل هذه الاعتمادات تدريجيًا أولًا، لأنها تجعل حتى الاختبارات المرجعية غير مستقرة.
وبالنسبة لمشاريعك تحديدًا، هذا يعني أنني لن أقول: «نحوّل برنامج موج كله الآن إلى Architecture جديدة». سأختار عملية تشغيل واحدة، أبني لها Baseline، ثم نفصلها ونقارن **قديم مقابل جديد**. إذا تطابقت، ننتقل للجزء التالي.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: الاعتماد على `ActiveSheet` و`Selection` والمتغيرات العامة قد يجعل نتائج الاختبار نفسها غير مستقرة.
Auto Claude: لو أردنا تطبيق هذا فعليًا على مشروع VBA كبير، ما **أول اعتماد خفي** تبحث عنه وتزيله قبل أي إعادة هيكلة، وكيف تكتشفه دون كسر البرنامج؟
### Auto Claude (Claude Sonnet 5.5)
أول اعتماد خفي أبحث عنه: **الاعتماد على `ActiveSheet` و`ActiveWorkbook` و`Selection`**، لأنه يجعل نتيجة نفس الكود تتغير حسب أي ورقة كانت مفتوحة وقت التشغيل. وبعده المتغيرات العامة التي تحمل حالة بين الاستدعاءات.
**كيف أكتشفه دون كسر البرنامج:**
1. **بحث نصي فقط (بدون تعديل):** أصدّر الوحدات (Export) وأبحث عن `ActiveSheet` و`Selection` و`ActiveCell` و`Activate` و`Select` و`Public` خارج الثوابت. هذا يعطي خريطة بالمواقع قبل لمس أي سطر.
2. **عدّ الاستخدامات:** أبدأ بالإجراء الذي ستختبره أولًا، وليس بكل المشروع.
3. **الاستبدال الآمن:** أمرر الورقة كمعامل (`ws As Worksheet`) بدل الاعتماد على الورقة النشطة، وأبقي الإجراء القديم غلافًا يستدعي الجديد بـ`ActiveSheet`. هكذا يبقى السلوك الظاهري ثابتًا.
4. **اختبار الحساسية:** أشغّل الإجراء مرتين، مرة والورقة النشطة هي الصحيحة، ومرة وورقة أخرى نشطة. أي اختلاف في النتيجة يكشف اعتمادًا خفيًا فعليًا.
**اعتراض على Chatty GPT 5.6:** قلت إن إزالة هذه الاعتمادات تسبق الفصل المعماري. أتفق، لكن بشرط: لا تكتب Baseline على سلوك غير مستقر. خذ اللقطة المرجعية **بعد** خطوة 4، وإلا ستثبّت نتائج عشوائية على أنها «الصحيحة».
**نقطة لم تُطرح:** الأحداث المتسلسلة (`Worksheet_Change` و`Workbook_Open`). قد تُشغَّل ضمنيًا عند تعديل الخلايا من الكود فتغيّر البيانات دون أن تظهر في الإجراء. أجرّب بتعطيل `Application.EnableEvents` أثناء الاختبار، وأقارن النتيجة مع وضعه الطبيعي.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: أحداث Excel مثل `Worksheet_Change` قد تصنع آثارًا جانبية لا تظهر داخل الإجراء الذي نختبره.
Chatty GPT 5.6: كيف تميّز عمليًا بين **حدث ضروري لسير البرنامج** وحدث يمثل اعتمادًا خفيًا يجب فصله، خصوصًا عندما يستدعي الحدث إجراءات أخرى متسلسلة؟
### Participant
الجميع يتوقف
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
تم. أتوقف هنا ولن أكمل النقاش أو أضيف أي رد على الجولة الحالية.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
تم إيقاف النقاش بناءً على طلب المستخدم. هل تريد **إنهاء الجلسة**، أم **إبقائها متوقفة مؤقتًا** للعودة إليها لاحقًا؟
### Participant
Option Explicit
'==========================================================
' سجل الأفكار والنتائج: مرجع ثابت لكل تجربة.
' F01 - تحرير تكليفين وإعادة تركيب الطاقم: طُبق في R8.
' النتيجة: وجد إصلاح 100، لكن رفضت المرحلة بسبب مقارنة الترتيب.
' F02 - مقارنة المحتوى دون ترتيب: طُبق في R9.
' النتيجة: اعتمد إصلاح 100 و115؛ بقي مقعدان، وتوقف الوقت.
' F03 - رفع البحث إلى 90 ثانية: تجربة R9 الثانية.
' النتيجة: بقي مقعدان؛ لم يسجل نقل فعلي للبيرنق 135.
' F04 - مقارنة الحالات المتغيرة وتقاسم الوقت وعمق 3: طُبق في R10.
' النتيجة: أصلح 147؛ بقي 135؛ انتهت 240 محاولة بعد بحث 86.1 ثانية.
' قياس R10: النسخ 63.3؛ المقارنة 14.9؛ التراجع 1.1 ثانية.
' F05 - نسخ حاويات القوائم وفصل سجل القيادة: جديد في R11.
' نتيجة R11: النسخ 15.0؛ المقارنة 3.5؛ إجمالي المرحلة 40.4 ثانية.
' المخالفات صفر؛ بقي قائد 135 ناقصًا.
' F06 - عمق 4 في الجولة الثالثة: جرب في R11، ولم يغط 135.
' توقفت المرحلة عند 240 محاولة بعد بحث 28.7 ثانية؛ البحث غير مكتمل.
' F07 - ذاكرة للمسارات الداخلية الفاشلة: لم تطبق بعد.
' السبب: يلزم مفتاح يشمل حالة الخطة والمسار والمنع والعمق؛
' تخزين فشل بسبب حد الوقت أو المحاولات قد يستبعد حلًا صالحًا.
' F08 - الحد الإجمالي 600 بدل 240: جرب؛ بقي قائد 135 ناقصًا.
' النتيجة: 253 محاولة، بحث 29.3 ثانية، إجمالي 40.6 ثانية؛ مخالفات صفر.
' سبب التوقف: حد الجولة الأخيرة 100 محاولة، وليس الوقت أو سقف 600.
' F09 - رفع حد الجولة الأخيرة إلى 400: بقي قائد 135 ناقصًا.
' F14 - تأكيد التصنيف نجح؛ بقي قائد 135 ناقصًا.
' تحديد المبيت من اسم الفندق ومدة المبيت في البيرنق فقط.
' يضيف التقرير دليل التصنيف لكل مرة تشغيل؛ النتيجة تنتظر التجربة.
' حدود الجولات الآن 20 ثم 60 ثم 400، والحد الإجمالي 600.
' الوقت 90 ثانية، والفحوص 20000، والأعماق 2 ثم 3 ثم 4 ثابتة.
' النتيجة الفعلية لكل فكرة تؤخذ من التقرير التالي، ولا تفترض مسبقًا.
'==========================================================
'==========================================================
' R19 - تطبيق مباشر لطريقة الخبير: المبيت زمنيًا قبل الراوندترب،
' وتكليف المبيت لا تنقله مرحلة الإصلاح بعد اعتماده.
' محرك توزيع الرحلات - المرحلة الثانية
'
' يبني خطة التوزيع في الذاكرة فقط، ولا يكتب في LINE.
' يعتمد على نجاح تحميل modDistributionReader أولًا.
'==========================================================
Public DE_Assignments As Collection
Private DE_LayoverDayLoads As Object
Public DE_RunPlans As Collection
Public DE_EmployeeStates As Object
Public DE_Warnings As Collection
Private DE_RTDayLoad As Object
Private DE_RepairOrderingChecks As Long
Private DE_RepairTransferSamples As Collection
Private DE_RepairTransferSampleKeys As Object
Private DE_RepairActivePath As Object
Private DE_RepairSampleKeys As Object
Private DE_RepairActiveDepth As Long
Private DE_RepairRootAttemptLimit As Long
Private DE_RepairDiagnosticCounts As Object
Private DE_RepairDiagnosticSamples As Collection
Private DE_RepairDepthReached As Boolean
Private DE_RepairRootAttemptStart As Long
Private DE_RepairAttempts As Long
Private Const DE_REPAIR_MAX_ATTEMPTS As Long = 600
Private DE_RepairRootDeadline As Double
Private DE_RepairCopySeconds As Double
Private DE_RepairCompareSeconds As Double
Private DE_RepairRollbackSeconds As Double
Private DE_RepairStartedAt As Double
Private DE_RepairChecks As Long
Private Const DE_REPAIR_MAX_SECONDS As Double = 90#
Private Const DE_REPAIR_MAX_CHECKS As Long = 20000
Private Const DE_REPAIR_DEPTH As Long = 2
Private DE_PreviousMonthRestCount As Long
Private DE_PreviousMonthRestOneDayCount As Long
Private DE_PreviousMonthRestTwoDaysCount As Long
Private DE_PreviousMonthRestThreeDaysCount As Long
Private Const DE_INFO As String = "INFO"
Private Const DE_PAIRING As String = "PAIRING"
Private Const DE_TYPE_FLIGHT As String = "FLIGHT"
Private Const DE_TYPE_OFFICE As String = "OFFICE"
Private Const DE_TYPE_EVENT As String = "EVENT"
Private Const DE_TYPE_SB As String = "SB"
Private Const DE_TYPE_RT As String = "RT"
Private Const DE_TYPE_PREVIOUS_MONTH_REST As String = _
"PREVIOUS_MONTH_REST"
' الحد الأعلى المسموح به فوق المستهدف لكل موظف.
' يمنع إخفاء العجز بتكرار الرحلات الإضافية على الموظف نفسه.
Private Const DE_MAX_EXTRA_FLIGHTS_PER_EMPLOYEE As Long = 1
' تفضيلات تشغيلية لتباعد الرحلات. هذه ليست منعًا مطلقًا؛
' فالحد الإلزامي يبقى راحة 24 ساعة، بينما يستخدم المحرك
' هذه القيم لاختيار الموظف صاحب الجدول الأقل ازدحامًا.
Private Const DE_PREFERRED_FLIGHT_GAP_HOURS As Double = 72#
Private Const DE_ACCEPTABLE_FLIGHT_GAP_HOURS As Double = 48#
'==========================================================
' بناء خطة التوزيع كاملة في الذاكرة
'==========================================================
Public Function DistributionEngine_BuildPlan( _
ByRef ErrorResults As Collection, _
ByRef PassedResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim CurrentStep As String
Dim ReaderPassed As Boolean
Dim ValidationPassed As Boolean
On Error GoTo EngineError
EnsureGregorianCalendar
DE_EnsureCollections ErrorResults, PassedResults, WarningResults
DistributionEngine_Clear
Set DE_Warnings = WarningResults
CurrentStep = "تحميل مصادر بيانات التوزيع"
If DR_Employees Is Nothing Then
ReaderPassed = DistributionReader_LoadAll( _
ErrorResults, PassedResults)
ElseIf DR_Employees.Count = 0 Then
ReaderPassed = DistributionReader_LoadAll( _
ErrorResults, PassedResults)
Else
ReaderPassed = True
End If
If Not ReaderPassed Then Exit Function
ValidationPassed = True
CurrentStep = "تجهيز حالات الموظفين"
If Not DE_InitializeEmployeeStates(ErrorResults) Then
ValidationPassed = False
End If
CurrentStep = "تحليل مرات تشغيل البيرنقات"
If Not DE_InitializeRunPlans(ErrorResults, PassedResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
CurrentStep = "تثبيت ارتباطات الموظفين"
If Not DE_RegisterEvents( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
CurrentStep = "تثبيت جداول الاستاندباي"
If Not DE_RegisterStandby(ErrorResults) Then
ValidationPassed = False
End If
CurrentStep = "تثبيت رحلات الإداريين"
If Not DE_RegisterOfficeFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
' يجب حجز أيام الاحتياط قبل توزيع الرحلات العادية؛
' حتى تُبنى الرحلات حول الاحتياط وفترة الراحة التالية له.
CurrentStep = "توزيع أيام الاحتياط"
If Not DE_DistributeReserveDays( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
' الاحتياط تكليف إلزامي. إذا تعذر حجز يوم مناسب له،
' لا يبدأ توزيع الرحلات على خطة ناقصة أو غير قابلة للتنفيذ.
If Not ValidationPassed Then Exit Function
' الرحلات المطالب بها من الشهر السابق تُثبت قبل التوزيع
' العادي؛ لأنها حق مرحّل للموظف وتُعد رحلة إضافية فوق
' مستهدفه الأساسي، مع تطبيق الأهلية والتعارض وراحة 24 ساعة.
CurrentStep = "توزيع الرحلات المطالب بها"
If Not DE_DistributeCarryoverFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
CurrentStep = "توزيع أطقم الرحلات"
If Not DE_DistributeFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
CurrentStep = "مراجعة ترتيب القيادة والأفراد"
If Not DE_ValidateRolePolicy(ErrorResults) Then
ValidationPassed = False
End If
' يضاف الملخص سواء نجحت الخطة أم ظهر عجز؛ حتى يوضح
' عدد الرحلات الإضافية المستخدمة فعليًا حسب المجموعة.
DE_AddExtraFlightSummary WarningResults
CurrentStep = "مراجعة توافق تأهيل الموظفين مع الناقلات"
If ValidationPassed Then
If Not DE_ValidateCarrierAssignments(ErrorResults) Then
ValidationPassed = False
End If
End If
If ValidationPassed Then
PassedResults.Add _
"نجح إنشاء خطة توزيع الرحلات في الذاكرة."
PassedResults.Add _
"عدد مرات التشغيل المخططة: " & _
CStr(DE_RunPlans.Count) & _
"، وعدد التكليفات: " & _
CStr(DE_Assignments.Count) & "."
PassedResults.Add _
"لم يتم تعديل أي خلية في شيت LINE."
PassedResults.Add _
"تكليفات الرحلات حسب الناقل: السعودية " & _
CStr(DE_CarrierAssignmentCount("SAUDIA")) & _
"، ناس " & CStr(DE_CarrierAssignmentCount("NAS")) & _
"، أديل " & CStr(DE_CarrierAssignmentCount("ADEAL")) & "."
PassedResults.Add _
"تمت تغطية الرحلات المطالب بها: " & _
CStr(DE_CarryoverAssignedCount()) & _
" من " & CStr(DR_CarryoverFlights.Count) & "."
PassedResults.Add _
"راحة بداية الشهر بسبب آخر رحلة في الشهر السابق: " & _
"يوم واحد لعدد " & _
CStr(DE_PreviousMonthRestOneDayCount) & _
"، يومان لعدد " & _
CStr(DE_PreviousMonthRestTwoDaysCount) & _
"، ثلاثة أيام لعدد " & _
CStr(DE_PreviousMonthRestThreeDaysCount) & _
"، والإجمالي " & _
CStr(DE_PreviousMonthRestCount) & " موظفًا."
End If
DistributionEngine_BuildPlan = ValidationPassed
Exit Function
EngineError:
DE_EnsureCollections ErrorResults, PassedResults, WarningResults
ErrorResults.Add _
"تعذر بناء خطة التوزيع أثناء " & CurrentStep & _
". تفاصيل الخطأ: " & Err.Description
DistributionEngine_BuildPlan = False
End Function
'==========================================================
' مسح خطة سابقة من الذاكرة
'==========================================================
Public Sub DistributionEngine_Clear()
Set DE_Assignments = New Collection
Set DE_RunPlans = New Collection
Set DE_EmployeeStates = _
CreateObject("Scripting.Dictionary")
DE_EmployeeStates.CompareMode = vbTextCompare
Set DE_Warnings = New Collection
Set DE_RTDayLoad = CreateObject("Scripting.Dictionary")
DE_RTDayLoad.CompareMode = vbTextCompare
DE_PreviousMonthRestCount = 0
DE_PreviousMonthRestOneDayCount = 0
DE_PreviousMonthRestTwoDaysCount = 0
DE_PreviousMonthRestThreeDaysCount = 0
End Sub
'==========================================================
' اختبار مستقل للمحرك من دون الكتابة في LINE
'==========================================================
Public Sub TestDistributionEngine()
Dim Errors As Collection
Dim Passed As Collection
Dim Warnings As Collection
Dim ResultPassed As Boolean
Set Errors = New Collection
Set Passed = New Collection
Set Warnings = New Collection
ResultPassed = DistributionEngine_BuildPlan( _
Errors, Passed, Warnings)
DE_WriteDistributionTestReport _
ResultPassed, Errors, Warnings, Passed
MsgBox _
"تم إنشاء تقرير اختبار التوزيع في شيت " & _
"DISTRIBUTION_REPORT.", _
IIf(ResultPassed, vbInformation, vbExclamation), _
"اختبار محرك التوزيع"
End Sub
'==========================================================
' إنشاء تقرير اختبار المحرك داخل شيت مستقل.
'
' لا يكتب هذا الإجراء أي شيء في LINE، ولا يحذف الشيت؛
' بل يمسح محتوى التقرير السابق ثم يكتب التقرير الجديد.
'==========================================================
Private Sub DE_WriteDistributionTestReport( _
ByVal ResultPassed As Boolean, _
ByVal ErrorResults As Collection, _
ByVal WarningResults As Collection, _
ByVal PassedResults As Collection)
Const REPORT_SHEET As String = _
"DISTRIBUTION_REPORT"
Dim ws As Worksheet
Dim NextRow As Long
Dim SequenceNumber As Long
Dim FinalRow As Long
Dim ReportRange As Range
Dim ReportWindow As Window
Dim PreviousScreenUpdating As Boolean
Dim ReportErrorNumber As Long
Dim ReportErrorDescription As String
PreviousScreenUpdating = Application.ScreenUpdating
On Error GoTo ReportError
Set ws = DE_GetOrCreateReportSheet(REPORT_SHEET)
Application.ScreenUpdating = False
ws.Visible = xlSheetVisible
ws.Cells.Clear
ws.DisplayRightToLeft = True
' عنوان التقرير.
With ws.Range("A1:D1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Bold = True
.Font.Size = 16
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(0, 78, 76)
End With
ws.Range("A1").Value = _
"تقرير اختبار محرك توزيع الرحلات"
ws.Rows(1).RowHeight = 28
ws.Range("A2").Value = "الشهر"
ws.Range("B2").Value = _
UCase$(MonthName(DR_ActiveMonth, True))
ws.Range("C2").Value = "السنة"
ws.Range("D2").Value = DR_ActiveYear
ws.Range("A3").Value = "نتيجة الاختبار"
If ResultPassed Then
ws.Range("B3").Value = "نجح الاختبار"
ws.Range("B3").Interior.Color = _
RGB(198, 239, 206)
ws.Range("B3").Font.Color = _
RGB(0, 97, 0)
Else
ws.Range("B3").Value = "لم تكتمل خطة التوزيع"
ws.Range("B3").Interior.Color = _
RGB(255, 199, 206)
ws.Range("B3").Font.Color = _
RGB(156, 0, 6)
End If
ws.Range("C3").Value = "تاريخ التقرير"
ws.Range("D3").NumberFormat = "@"
ws.Range("D3").Value = _
"'" & Format$(Now, "dd/mm/yyyy hh:mm")
With ws.Range("A2:D3")
.Borders.LineStyle = xlContinuous
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
' رؤوس أعمدة النتائج.
ws.Range("A5").Value = "التسلسل"
ws.Range("B5").Value = "التصنيف"
ws.Range("C5").Value = "الحالة"
ws.Range("D5").Value = "التفاصيل"
With ws.Range("A5:D5")
.Font.Bold = True
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(0, 78, 76)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
End With
NextRow = 6
SequenceNumber = 0
DE_WriteReportCollection _
ws, ErrorResults, "خطأ", _
NextRow, SequenceNumber
DE_WriteReportCollection _
ws, WarningResults, "تنبيه", _
NextRow, SequenceNumber
DE_WriteReportCollection _
ws, PassedResults, "سليم", _
NextRow, SequenceNumber
If SequenceNumber = 0 Then
SequenceNumber = 1
ws.Cells(NextRow, "A").Value = SequenceNumber
ws.Cells(NextRow, "B").Value = "معلومة"
ws.Cells(NextRow, "C").Value = "لا توجد نتائج"
ws.Cells(NextRow, "D").Value = _
"لم يُرجع المحرك أي نتائج لعرضها."
NextRow = NextRow + 1
End If
FinalRow = NextRow - 1
Set ReportRange = ws.Range( _
"A5:D" & CStr(FinalRow))
With ReportRange
.Borders.LineStyle = xlContinuous
.VerticalAlignment = xlTop
End With
ws.Range("A6:C" & CStr(FinalRow)).HorizontalAlignment = _
xlCenter
ws.Range("D6:D" & CStr(FinalRow)).HorizontalAlignment = _
xlRight
ws.Range("D6:D" & CStr(FinalRow)).WrapText = True
ws.Columns("A").ColumnWidth = 10
ws.Columns("B").ColumnWidth = 16
ws.Columns("C").ColumnWidth = 20
ws.Columns("D").ColumnWidth = 95
ws.Rows("2:3").AutoFit
ws.Rows("5:" & CStr(FinalRow)).AutoFit
If ws.AutoFilterMode Then ws.AutoFilterMode = False
ws.Range("A5:D" & CStr(FinalRow)).AutoFilter
' إعداد عرض التقرير اختياري ولا يوقف كتابة النتائج.
On Error Resume Next
ws.Parent.Activate
ws.Activate
Set ReportWindow = Application.ActiveWindow
If Not ReportWindow Is Nothing Then
ReportWindow.View = xlNormalView
ReportWindow.FreezePanes = False
ReportWindow.SplitRow = 0
ReportWindow.SplitColumn = 0
Err.Clear
ws.Range("A6").Select
If Err.Number = 0 Then
ReportWindow.SplitRow = 5
ReportWindow.FreezePanes = True
End If
End If
Err.Clear
On Error GoTo ReportError
Application.ScreenUpdating = PreviousScreenUpdating
Exit Sub
ReportError:
ReportErrorNumber = Err.Number
ReportErrorDescription = Err.Description
Application.ScreenUpdating = PreviousScreenUpdating
MsgBox "تعذر إخراج التقرير. رقم الخطأ: " & CStr(ReportErrorNumber) & _
vbCrLf & ReportErrorDescription, vbExclamation, "تقرير التوزيع"
End Sub
'==========================================================
' إرجاع شيت التقرير أو إنشاؤه إذا لم يكن موجودًا.
'==========================================================
Private Function DE_GetOrCreateReportSheet( _
ByVal SheetName As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(SheetName)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add( _
After:=ThisWorkbook.Worksheets( _
ThisWorkbook.Worksheets.Count))
ws.NAME = SheetName
End If
Set DE_GetOrCreateReportSheet = ws
End Function
'==========================================================
' كتابة مجموعة نتائج في تقرير الاختبار.
'==========================================================
Private Sub DE_WriteReportCollection( _
ByVal ws As Worksheet, _
ByVal Results As Collection, _
ByVal DefaultCategory As String, _
ByRef NextRow As Long, _
ByRef SequenceNumber As Long)
Dim Item As Variant
Dim ResultText As String
Dim CategoryText As String
Dim StatusText As String
If Results Is Nothing Then Exit Sub
For Each Item In Results
ResultText = CStr(Item)
CategoryText = DefaultCategory
StatusText = DefaultCategory
If DE_IsShortageDiagnostic(ResultText) Then
CategoryText = "تشخيص عجز"
StatusText = "تفاصيل الموانع"
ElseIf DefaultCategory = "خطأ" _
And InStr(1, ResultText, _
"عجز", vbTextCompare) > 0 Then
CategoryText = "عجز"
StatusText = "غير مغطى"
ElseIf DefaultCategory = "خطأ" Then
StatusText = "يحتاج معالجة"
ElseIf DefaultCategory = "تنبيه" Then
StatusText = "للمراجعة"
ElseIf DefaultCategory = "سليم" Then
StatusText = "مكتمل"
End If
SequenceNumber = SequenceNumber + 1
ws.Cells(NextRow, "A").Value = SequenceNumber
ws.Cells(NextRow, "B").Value = CategoryText
ws.Cells(NextRow, "C").Value = StatusText
ws.Cells(NextRow, "D").Value = ResultText
DE_ApplyReportRowColor _
ws.Range("A" & CStr(NextRow) & _
":D" & CStr(NextRow)), _
CategoryText
NextRow = NextRow + 1
Next Item
End Sub
'==========================================================
' تلوين صف التقرير حسب نوع النتيجة.
'==========================================================
Private Sub DE_ApplyReportRowColor( _
ByVal TargetRange As Range, _
ByVal CategoryText As String)
Select Case CategoryText
Case "خطأ"
TargetRange.Interior.Color = _
RGB(255, 199, 206)
TargetRange.Font.Color = _
RGB(156, 0, 6)
Case "عجز", "تشخيص عجز"
TargetRange.Interior.Color = _
RGB(252, 229, 205)
TargetRange.Font.Color = _
RGB(156, 87, 0)
Case "تنبيه"
TargetRange.Interior.Color = _
RGB(255, 242, 204)
TargetRange.Font.Color = _
RGB(127, 96, 0)
Case "سليم"
TargetRange.Interior.Color = _
RGB(198, 239, 206)
TargetRange.Font.Color = _
RGB(0, 97, 0)
Case Else
TargetRange.Interior.Color = _
RGB(217, 217, 217)
TargetRange.Font.Color = _
RGB(0, 0, 0)
End Select
End Sub
'==========================================================
' التحقق من أن النص تقرير تشخيص عجز تفصيلي.
'==========================================================
Private Function DE_IsShortageDiagnostic( _
ByVal ResultText As String) As Boolean
DE_IsShortageDiagnostic = _
(Left$(Trim$(ResultText), _
Len("[تشخيص]")) = "[تشخيص]" _
Or Left$(Trim$(ResultText), Len("[أهلية فعلية")) = "[أهلية فعلية")
End Function
'==========================================================
' عرض تقارير تشخيص العجز في رسائل منفصلة.
'==========================================================
Private Sub DE_ShowShortageDiagnostics( _
ByVal ErrorResults As Collection)
Dim Item As Variant
Dim DiagnosticNumber As Long
If ErrorResults Is Nothing Then Exit Sub
For Each Item In ErrorResults
If DE_IsShortageDiagnostic(CStr(Item)) Then
DiagnosticNumber = DiagnosticNumber + 1
DE_ShowLongDiagnostic _
CStr(Item), _
"تفاصيل عجز التوزيع " & _
CStr(DiagnosticNumber)
End If
Next Item
End Sub
'==========================================================
' تقسيم التقرير الطويل إلى صفحات من دون قطع السطور.
'==========================================================
Private Sub DE_ShowLongDiagnostic( _
ByVal DiagnosticText As String, _
ByVal WindowTitle As String)
Const MAX_PAGE_LENGTH As Long = 650
Dim Lines As Variant
Dim LineItem As Variant
Dim CurrentPage As String
Dim Pages As Collection
Dim PageNumber As Long
Dim CandidateText As String
Set Pages = New Collection
Lines = Split(DiagnosticText, vbCrLf)
For Each LineItem In Lines
If CurrentPage = vbNullString Then
CandidateText = CStr(LineItem)
Else
CandidateText = CurrentPage & _
vbCrLf & CStr(LineItem)
End If
If Len(CandidateText) > MAX_PAGE_LENGTH _
And CurrentPage <> vbNullString Then
Pages.Add CurrentPage
CurrentPage = CStr(LineItem)
Else
CurrentPage = CandidateText
End If
Next LineItem
If CurrentPage <> vbNullString Then
Pages.Add CurrentPage
End If
For PageNumber = 1 To Pages.Count
MsgBox _
CStr(Pages(PageNumber)), _
vbExclamation, _
WindowTitle & " - الصفحة " & _
CStr(PageNumber) & " من " & _
CStr(Pages.Count)
Next PageNumber
End Sub
'==========================================================
' تجهيز حالة كل موظف ومستهدف مجموعته
'==========================================================
Private Function DE_GroupFlightTarget(ByVal GroupCode As String) As Long
Select Case UCase$(Trim$(GroupCode))
Case "SSS", "SST": DE_GroupFlightTarget = 7
Case "STS": DE_GroupFlightTarget = 8
Case "STT": DE_GroupFlightTarget = 10
End Select
End Function
Private Function DE_InitializeEmployeeStates( _
ByRef ErrorResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim EmployeeRecord As Object
Dim State As Object
Dim Targets As Object
Dim GroupCode As String
Dim BusyPeriods As Collection
Dim EmployeeAssignments As Collection
Dim EventDates As Object
Dim PreviousLastFlightDate As Date
Dim PreviousMonthEnd As Date
Dim NewMonthStart As Date
Dim PreviousMonthRestEnd As Date
Dim PreviousMonthRestDays As Long
Dim PreviousTripType As String
Set Targets = DE_ReadGroupTargets(ErrorResults)
If Targets Is Nothing Then Exit Function
For Each EmployeeKey In DR_Employees.Keys
Set EmployeeRecord = DR_Employees(EmployeeKey)
GroupCode = UCase$(CStr(EmployeeRecord("GroupCode")))
If Not Targets.Exists(GroupCode) Then
ErrorResults.Add _
"لا يوجد مستهدف للمجموعة " & GroupCode & _
" الخاصة بالموظف " & CStr(EmployeeKey) & "."
Exit Function
End If
Set State = DE_NewRecord()
State.Add "EmployeeNumber", CStr(EmployeeKey)
State.Add "EmployeeName", _
CStr(EmployeeRecord("EmployeeName"))
State.Add "GroupCode", GroupCode
State.Add "CarrierProfile", _
UCase$(CStr(EmployeeRecord("CarrierProfile")))
State.Add "InfoRow", CLng(EmployeeRecord("InfoRow"))
State.Add "LineRow", CLng(EmployeeRecord("LineRow"))
State.Add "IsOffice", CBool(EmployeeRecord("IsOffice"))
State.Add "IsHold", CBool(EmployeeRecord("IsHold"))
State.Add "IsStandby", _
DR_SBByEmployee.Exists(CStr(EmployeeKey))
State.Add "OriginalFlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "NormalFlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "FlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "OriginalLayoverTarget", _
CLng(Targets(GroupCode)("Layovers"))
State.Add "LayoverTarget", _
CLng(Targets(GroupCode)("Layovers"))
State.Add "LongLayoverTarget", 0&
State.Add "ShortLayoverTarget", 0&
State.Add "LongLayoverCount", 0&
State.Add "ShortLayoverCount", 0&
State.Add "EventDayCount", 0&
State.Add "LongestEventDays", 0&
State.Add "TargetAdjustmentReason", vbNullString
State.Add "IsNoFlightMonth", False
State.Add "SaudiaTarget", 0&
State.Add "SpecialCarrierTarget", 0&
State.Add "SpecialCarrierCode", vbNullString
State.Add "SaudiaCount", 0&
State.Add "SpecialCarrierCount", 0&
State.Add "FlightCount", 0&
State.Add "LayoverCount", 0&
State.Add "CarryoverTarget", _
DE_EmployeeCarryoverCount(CStr(EmployeeKey))
State.Add "CarryoverAssigned", 0&
State.Add "CarryoverLayoverCount", 0&
State.Add "CarryoverLongLayoverCount", 0&
State.Add "CarryoverShortLayoverCount", 0&
State.Add "CarryoverSaudiaTarget", _
DE_EmployeeCarryoverCarrierCount( _
CStr(EmployeeKey), "SAUDIA")
State.Add "CarryoverSpecialTarget", _
DE_EmployeeCarryoverSpecialCount( _
CStr(EmployeeKey))
State.Add "LeaderCount", 0&
State.Add "ReserveCount", 0&
State.Add "HasPreviousMonthEndRest", False
' عدد الرحلات التي أضيفت فوق مستهدف المجموعة لمعالجة العجز
State.Add "ExtraFlightCount", 0&
Set BusyPeriods = New Collection
Set EmployeeAssignments = New Collection
Set EventDates = CreateObject("Scripting.Dictionary")
EventDates.CompareMode = vbTextCompare
State.Add "BusyPeriods", BusyPeriods
State.Add "Assignments", EmployeeAssignments
State.Add "EventDates", EventDates
' إذا كانت آخر رحلة للموظف في آخر يوم من الشهر السابق،
' تُحجز راحة بداية الشهر حسب تصنيف الرحلة السابقة:
' LAY = ثلاثة أيام، LNG أو MED = يومان، SHT = يوم واحد.
' وتستمر بقية شروط الراحة والتعارض دون أي تغيير.
If EmployeeRecord.Exists("HasPreviousLastFlight") Then
If CBool(EmployeeRecord("HasPreviousLastFlight")) Then
PreviousLastFlightDate = CDate(CDbl( _
EmployeeRecord("PreviousLastFlightDate")))
PreviousMonthEnd = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 0)
If Int(CDbl(PreviousLastFlightDate)) = _
Int(CDbl(PreviousMonthEnd)) Then
NewMonthStart = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 1)
PreviousMonthRestDays = _
DE_GetPreviousMonthRestDays( _
EmployeeRecord, PreviousTripType)
PreviousMonthRestEnd = DateAdd( _
"d", PreviousMonthRestDays, NewMonthStart)
DE_AddBusyPeriod _
State, _
NewMonthStart, _
PreviousMonthRestEnd, _
DE_TYPE_PREVIOUS_MONTH_REST, _
False, _
"راحة بداية الشهر لمدة " & _
DE_ArabicDayPhrase(PreviousMonthRestDays) & _
" بسبب رحلة " & PreviousTripType & _
" في آخر يوم من الشهر السابق"
State("HasPreviousMonthEndRest") = True
DE_PreviousMonthRestCount = _
DE_PreviousMonthRestCount + 1
Select Case PreviousMonthRestDays
Case 1
DE_PreviousMonthRestOneDayCount = _
DE_PreviousMonthRestOneDayCount + 1
Case 2
DE_PreviousMonthRestTwoDaysCount = _
DE_PreviousMonthRestTwoDaysCount + 1
Case 3
DE_PreviousMonthRestThreeDaysCount = _
DE_PreviousMonthRestThreeDaysCount + 1
End Select
End If
End If
End If
DE_EmployeeStates.Add CStr(EmployeeKey), State
Next EmployeeKey
DE_InitializeEmployeeStates = True
End Function
'==========================================================
' حساب عدد المطالبات المسجلة لموظف
'==========================================================
Private Function DE_EmployeeCarryoverCount( _
ByVal EmployeeNumber As String) As Long
Dim CarryoverRecord As Object
For Each CarryoverRecord In DR_CarryoverFlights
If StrComp(CStr(CarryoverRecord("EmployeeNumber")), _
EmployeeNumber, vbTextCompare) = 0 Then
DE_EmployeeCarryoverCount = _
DE_EmployeeCarryoverCount + 1
End If
Next CarryoverRecord
End Function
'==========================================================
' حساب مطالبات موظف لناقل محدد
'==========================================================
Private Function DE_EmployeeCarryoverCarrierCount( _
ByVal EmployeeNumber As String, _
ByVal CarrierCode As String) As Long
Dim CarryoverRecord As Object
For Each CarryoverRecord In DR_CarryoverFlights
If StrComp(CStr(CarryoverRecord("EmployeeNumber")), _
EmployeeNumber, vbTextCompare) = 0 _
And StrComp(CStr(CarryoverRecord("CarrierCode")), _
CarrierCode, vbTextCompare) = 0 Then
DE_EmployeeCarryoverCarrierCount = _
DE_EmployeeCarryoverCarrierCount + 1
End If
Next CarryoverRecord
End Function
'==========================================================
' حساب مطالبات الموظف للناقل المتخصص في ملفه
'==========================================================
Private Function DE_EmployeeCarryoverSpecialCount( _
ByVal EmployeeNumber As String) As Long
Dim EmployeeRecord As Object
Dim SpecialCarrier As String
If Not DR_Employees.Exists(EmployeeNumber) Then Exit Function
Set EmployeeRecord = DR_Employees(EmployeeNumber)
Select Case UCase$(CStr(EmployeeRecord("CarrierProfile")))
Case "SAUDIA_NAS": SpecialCarrier = "NAS"
Case "SAUDIA_ADEAL": SpecialCarrier = "ADEAL"
Case Else: Exit Function
End Select
DE_EmployeeCarryoverSpecialCount = _
DE_EmployeeCarryoverCarrierCount( _
EmployeeNumber, SpecialCarrier)
End Function
'==========================================================
' قراءة مستهدف الرحلات والمبيت من INFO!K:M
'==========================================================
Private Function DE_ReadGroupTargets( _
ByRef ErrorResults As Collection) As Object
Dim ws As Worksheet
Dim Targets As Object
Dim LastRow As Long
Dim CurrentRow As Long
Dim GroupCode As String
Dim FlightsText As String
Dim LayoversText As String
Dim Target As Object
Set ws = ThisWorkbook.Worksheets(DE_INFO)
Set Targets = CreateObject("Scripting.Dictionary")
Targets.CompareMode = vbTextCompare
LastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row
For CurrentRow = 1 To LastRow
GroupCode = UCase$(DE_Text( _
ws.Cells(CurrentRow, "K").Value2))
If DE_IsGroupCode(GroupCode) Then
FlightsText = DE_Text( _
ws.Cells(CurrentRow, "L").Value2)
LayoversText = DE_Text( _
ws.Cells(CurrentRow, "M").Value2)
If Not DE_IsDigits(FlightsText) _
Or Not DE_IsDigits(LayoversText) Then
ErrorResults.Add _
"مستهدف المجموعة " & GroupCode & _
" غير صحيح في INFO!K:M."
Exit Function
End If
Set Target = DE_NewRecord()
Target.Add "Flights", CLng(FlightsText)
Target.Add "Layovers", CLng(LayoversText)
If Targets.Exists(GroupCode) Then
Targets.Remove GroupCode
End If
Targets.Add GroupCode, Target
End If
Next CurrentRow
If Targets.Count <> 4 Then
ErrorResults.Add _
"تعذر قراءة مستهدفات المجموعات الأربع من INFO!K:M."
Exit Function
End If
Set DE_ReadGroupTargets = Targets
End Function
'==========================================================
' تحليل كل مرة تشغيل وإضافة تفاصيلها اللازمة للتوزيع
'==========================================================
Private Function DE_InitializeRunPlans( _
ByRef ErrorResults As Collection, _
ByRef PassedResults As Collection) As Boolean
Dim ws As Worksheet
Dim SourceRun As Object
Dim RunPlan As Object
Dim SortedRuns() As Object
Dim RunCount As Long
Dim Index As Long
Dim SwapIndex As Long
Dim TempRun As Object
Set ws = ThisWorkbook.Worksheets(DE_PAIRING)
RunCount = DR_PairingRuns.Count
If RunCount = 0 Then
ErrorResults.Add "لا توجد مرات تشغيل جاهزة للتوزيع."
Exit Function
End If
ReDim SortedRuns(1 To RunCount)
For Index = 1 To RunCount
Set SourceRun = DR_PairingRuns(Index)
Set RunPlan = DE_BuildRunPlan( _
ws, SourceRun, ErrorResults)
If RunPlan Is Nothing Then Exit Function
Set SortedRuns(Index) = RunPlan
PassedResults.Add "[تصنيف البيرنق] " & _
CStr(RunPlan("PairingNumber")) & " بتاريخ " & _
Format$(CDate(RunPlan("OperatingDate")), "dd/mm/yyyy") & _
": " & CStr(RunPlan("LayoverEvidence"))
Next Index
' ترتيب زمني ثابت؛ وعند تساوي التاريخ يرتب برقم البيرنق.
For Index = 1 To RunCount - 1
For SwapIndex = Index + 1 To RunCount
If DE_RunComesAfter( _
SortedRuns(Index), SortedRuns(SwapIndex)) Then
Set TempRun = SortedRuns(Index)
Set SortedRuns(Index) = SortedRuns(SwapIndex)
Set SortedRuns(SwapIndex) = TempRun
End If
Next SwapIndex
Next Index
For Index = 1 To RunCount
SortedRuns(Index)("RunIndex") = Index
DE_RunPlans.Add SortedRuns(Index)
Next Index
DE_InitializeRunPlans = True
End Function
Private Function DE_BuildRunPlan( _
ByVal ws As Worksheet, _
ByVal SourceRun As Object, _
ByRef ErrorResults As Collection) As Object
Dim StartRow As Long
Dim CreditRow As Long
Dim StartColumn As Long
Dim EndColumn As Long
Dim DetailRow As Long
Dim FirstFlightRow As Long
Dim LastFlightRow As Long
Dim LayoverRow As Long
Dim HotelName As String
Dim CandidateHotel As String
Dim HotelColumn As Long
Dim DurationText As String
Dim FlightDayCode As String
Dim FirstDayCode As String
Dim LastDayCode As String
Dim StationCode As String
Dim LayoverStation As String
Dim LayoverClass As String
Dim LayoverHours As Double
Dim TripType As String
Dim RequiredCrew As Long
Dim StartClock As Double
Dim EndClock As Double
Dim DayOffset As Long
Dim OperatingDate As Date
Dim StartDateTime As Date
Dim EndDateTime As Date
Dim RunPlan As Object
Dim AssignedEmployees As Collection
StartRow = CLng(SourceRun("StartRow"))
CreditRow = CLng(SourceRun("CreditRow"))
StartColumn = CLng(SourceRun("StartColumn"))
EndColumn = CLng(SourceRun("EndColumn"))
FirstDayCode = UCase$(CStr(SourceRun("DayCode")))
OperatingDate = CDate(CDbl(SourceRun("OperatingDate")))
For DetailRow = StartRow + 2 To CreditRow - 1
FlightDayCode = UCase$(DE_Text( _
ws.Cells(DetailRow, StartColumn).Value2))
If DE_IsDayCode(FlightDayCode) Then
If FirstFlightRow = 0 Then FirstFlightRow = DetailRow
LastFlightRow = DetailRow
ElseIf DE_RowHasData( _
ws, DetailRow, StartColumn, EndColumn) Then
' اسم الفندق يقع قبل عمودي محطة المبيت ومدته.
' تجاهل الصفوف الفارغة والملاحظات التي لا تحمل بيانات مبيت.
CandidateHotel = vbNullString
For HotelColumn = StartColumn To StartColumn + 7
If Not IsError(ws.Cells(DetailRow, HotelColumn).Value2) Then
DurationText = DE_Text( _
ws.Cells(DetailRow, HotelColumn).Value2)
If DurationText <> vbNullString Then
If Not IsNumeric(DurationText) Then
If CandidateHotel <> vbNullString Then _
CandidateHotel = CandidateHotel & " "
CandidateHotel = CandidateHotel & DurationText
End If
End If
End If
Next HotelColumn
DurationText = DE_Text( _
ws.Cells(DetailRow, StartColumn + 9).Value2)
' لا يكفي اختلاف يوم العودة أو اسم المحطة لإثبات المبيت.
If CandidateHotel <> vbNullString Or _
DurationText <> vbNullString Then
If CandidateHotel = vbNullString Then
ErrorResults.Add "مدة مبيت دون اسم فندق في البيرنق " & _
CStr(SourceRun("PairingNumber")) & _
"، صف " & CStr(DetailRow) & ". راجع بيانات البيرنق."
Exit Function
End If
If LayoverRow > 0 Then
ErrorResults.Add "يوجد أكثر من سطر مبيت في البيرنق " & _
CStr(SourceRun("PairingNumber")) & _
". يلزم دعم المبيت المتعدد قبل توزيعه."
Exit Function
End If
LayoverRow = DetailRow
HotelName = CandidateHotel
End If
End If
Next DetailRow
If FirstFlightRow = 0 Or LastFlightRow = 0 Then
ErrorResults.Add _
"تعذر قراءة قطاعات البيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
StationCode = UCase$(DE_Text( _
ws.Cells(FirstFlightRow, StartColumn + 6).Value2))
If StationCode = "JED" Then
StationCode = UCase$(DE_Text( _
ws.Cells(LastFlightRow, StartColumn + 3).Value2))
End If
If LayoverRow > 0 Then
LayoverStation = UCase$(DE_Text( _
ws.Cells(LayoverRow, StartColumn + 8).Value2))
If LayoverStation <> vbNullString Then
StationCode = LayoverStation
End If
If Not DE_ReadDurationHours( _
ws.Cells(LayoverRow, StartColumn + 9), _
LayoverHours) Then
ErrorResults.Add _
"تعذر قراءة ساعات المبيت للبيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If LayoverHours <= 0# Or LayoverStation = vbNullString Then
ErrorResults.Add _
"بيانات المبيت ناقصة أو مدته غير موجبة للبيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If LayoverHours >= 50# Then
LayoverClass = "LONG"
Else
LayoverClass = "SHORT"
End If
End If
If Not DR_CrewRequirements.Exists(StationCode) Then
ErrorResults.Add _
"المحطة " & StationCode & _
" للبيرنق " & CStr(SourceRun("PairingNumber")) & _
" غير موجودة ضمن متطلبات INFO!G:I."
Exit Function
End If
RequiredCrew = CLng( _
DR_CrewRequirements(StationCode)("CrewCount"))
TripType = CStr( _
DR_CrewRequirements(StationCode)("TripType"))
' عدد أفراد المبيت مستقل عن عدد أفراد الراوندترب للمحطة.
If LayoverRow > 0 Then RequiredCrew = 2
' استثناء عدد الطاقم اختياري ومقيد بالشهر والسنة والبيرنق.
If Not DE_ResolveCrewOverride( _
CStr(SourceRun("PairingNumber")), OperatingDate, _
RequiredCrew, ErrorResults) Then Exit Function
If Not DE_ReadClock( _
ws.Cells(FirstFlightRow, StartColumn + 4), StartClock) Then
ErrorResults.Add _
"تعذر قراءة وقت بداية البيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If Not DE_ReadClock( _
ws.Cells(LastFlightRow, StartColumn + 7), EndClock) Then
ErrorResults.Add _
"تعذر قراءة وقت نهاية البيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
LastDayCode = UCase$(DE_Text( _
ws.Cells(LastFlightRow, StartColumn).Value2))
DayOffset = DE_DayOffset(FirstDayCode, LastDayCode)
If DayOffset = 0 Then
If EndClock < DE_CellClockValue( _
ws.Cells(LastFlightRow, StartColumn + 4)) Then
DayOffset = 1
End If
End If
StartDateTime = OperatingDate + StartClock
EndDateTime = OperatingDate + DayOffset + EndClock
If EndDateTime <= StartDateTime Then
EndDateTime = EndDateTime + 1
End If
Set RunPlan = DE_NewRecord()
RunPlan.Add "RunIndex", 0&
RunPlan.Add "PairingNumber", _
CStr(SourceRun("PairingNumber"))
' رحلات حلب ALP تُغطى حصريًا بواسطة المؤهلين لرحلات ناس،
' حتى لو كانت واقعة قبل عنوان FLY NAS في شيت PAIRING.
If StationCode = "ALP" Then
RunPlan.Add "CarrierCode", "NAS"
Else
RunPlan.Add "CarrierCode", _
UCase$(CStr(SourceRun("CarrierCode")))
End If
RunPlan.Add "OperatingDate", CDbl(OperatingDate)
RunPlan.Add "StartDateTime", CDbl(StartDateTime)
RunPlan.Add "EndDateTime", CDbl(EndDateTime)
RunPlan.Add "ReturnDayOffset", DayOffset
RunPlan.Add "StationCode", StationCode
RunPlan.Add "TripType", TripType
RunPlan.Add "IsLayover", (LayoverRow > 0)
RunPlan.Add "HotelName", HotelName
If LayoverRow > 0 Then
RunPlan.Add "LayoverEvidence", _
"مبيت؛ الفندق: " & HotelName & _
"؛ المدة بالساعات: " & Format$(LayoverHours, "0.00") & _
"؛ صف المصدر: " & CStr(LayoverRow)
Else
RunPlan.Add "LayoverEvidence", _
"راوندترب؛ لا يوجد سطر فندق ومدة مبيت في البيرنق."
End If
RunPlan.Add "LayoverHours", LayoverHours
RunPlan.Add "LayoverClass", LayoverClass
RunPlan.Add "RequiredCrew", RequiredCrew
RunPlan.Add "StartRow", StartRow
RunPlan.Add "CreditRow", CreditRow
RunPlan.Add "StartColumn", StartColumn
Set AssignedEmployees = New Collection
RunPlan.Add "AssignedEmployees", AssignedEmployees
RunPlan.Add "LeaderEmployee", vbNullString
RunPlan.Add "OfficeCount", 0&
Set DE_BuildRunPlan = RunPlan
End Function
'==========================================================
' تثبيت الارتباطات باعتبارها فترات منع
'==========================================================
Private Function DE_RegisterEvents( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim EventRecord As Object
Dim State As Object
Dim EmployeeNumber As String
Dim StartDate As Date
Dim EndDate As Date
Dim MonthStart As Date
Dim MonthEnd As Date
Dim ActiveStart As Date
Dim ActiveEnd As Date
Dim DateCursor As Date
Dim DateKey As String
Dim EventDates As Object
MonthStart = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 1)
MonthEnd = DateSerial( _
DR_ActiveYear, DR_ActiveMonth + 1, 0)
For Each EventRecord In DR_Events
EmployeeNumber = CStr(EventRecord("EmployeeNumber"))
If Not DE_EmployeeStates.Exists(EmployeeNumber) Then
ErrorResults.Add _
"موظف الارتباط رقم " & EmployeeNumber & _
" غير موجود ضمن حالات التوزيع."
Exit Function
End If
Set State = DE_EmployeeStates(EmployeeNumber)
StartDate = CDate(CDbl(EventRecord("StartDate")))
EndDate = CDate(CDbl(EventRecord("EndDate"))) + 1
DE_AddBusyPeriod State, StartDate, EndDate, _
DE_TYPE_EVENT, False, _
CStr(EventRecord("EventName"))
ActiveStart = StartDate
If ActiveStart < MonthStart Then ActiveStart = MonthStart
ActiveEnd = EndDate - 1
If ActiveEnd > MonthEnd Then ActiveEnd = MonthEnd
If ActiveStart <= ActiveEnd Then
Set EventDates = State("EventDates")
If CLng(CDbl(ActiveEnd) - _
CDbl(ActiveStart) + 1) > _
CLng(State("LongestEventDays")) Then
State("LongestEventDays") = _
CLng(CDbl(ActiveEnd) - _
CDbl(ActiveStart) + 1)
End If
For DateCursor = ActiveStart To ActiveEnd
DateKey = CStr(CLng(CDbl(DateCursor)))
If Not EventDates.Exists(DateKey) Then
EventDates.Add DateKey, True
End If
Next DateCursor
End If
Next EventRecord
If Not DE_ApplyEventTargetAdjustments( _
ErrorResults, WarningResults) Then Exit Function
DE_RegisterEvents = True
End Function
'==========================================================
' تحديد راحة بداية الشهر من تصنيف آخر رحلة في الشهر السابق
'==========================================================
Private Function DE_GetPreviousMonthRestDays( _
ByVal EmployeeRecord As Object, _
ByRef PreviousTripType As String) As Long
Dim StationCode As String
Dim SeparatorPosition As Long
Dim Requirement As Object
PreviousTripType = vbNullString
If EmployeeRecord.Exists("PreviousLastStation") Then
StationCode = UCase$(Trim$(CStr( _
EmployeeRecord("PreviousLastStation"))))
End If
' قد تُحفظ الرحلة السابقة مثل DAC-MED أو DAC MED؛
' التصنيف يعتمد على محطة الذهاب الأساسية.
StationCode = Replace$(StationCode, "/", "-")
StationCode = Replace$(StationCode, " ", "-")
Do While InStr(1, StationCode, "--", vbBinaryCompare) > 0
StationCode = Replace$(StationCode, "--", "-")
Loop
SeparatorPosition = InStr(1, StationCode, "-", vbTextCompare)
If SeparatorPosition > 1 Then
StationCode = Left$(StationCode, SeparatorPosition - 1)
ElseIf Len(StationCode) = 6 Then
StationCode = Left$(StationCode, 3)
End If
If Not DR_CrewRequirements Is Nothing Then
If DR_CrewRequirements.Exists(StationCode) Then
Set Requirement = DR_CrewRequirements(StationCode)
PreviousTripType = UCase$(Trim$(CStr( _
Requirement("TripType"))))
End If
End If
Select Case PreviousTripType
Case "LAY"
DE_GetPreviousMonthRestDays = 3
Case "LNG", "MED"
DE_GetPreviousMonthRestDays = 2
Case "SHT"
DE_GetPreviousMonthRestDays = 1
Case Else
' إذا تعذر التعرف على التصنيف، نستخدم يومين كحل آمن
' ونسجل تنبيهًا واضحًا بدل إيقاف خطة التوزيع بالكامل.
DE_GetPreviousMonthRestDays = 2
PreviousTripType = "غير مصنفة"
If Not DE_Warnings Is Nothing Then
DE_Warnings.Add _
"تعذر تحديد تصنيف آخر رحلة للموظف " & _
CStr(EmployeeRecord("EmployeeNumber")) & _
" من المحطة [" & StationCode & _
"]. تم اعتماد يومين راحة بصورة احتياطية."
End If
End Select
End Function
'==========================================================
' صياغة كلمة يوم في وصف فترة الراحة
'==========================================================
Private Function DE_ArabicDayPhrase( _
ByVal DayCount As Long) As String
Select Case DayCount
Case 1
DE_ArabicDayPhrase = "يوم واحد"
Case 2
DE_ArabicDayPhrase = "يومين"
Case Else
DE_ArabicDayPhrase = CStr(DayCount) & " أيام"
End Select
End Function
'==========================================================
' تعديل مستهدف الموظف حسب مجموع أيام ارتباطاته في الشهر
'
' المدد المعتمدة:
' 10 أيام: خصم رحلتين.
' 15 يومًا: نصف المستهدف مع التقريب للأعلى.
' 30 يومًا: منع كامل من الرحلات والمبيت والاحتياط.
'==========================================================
Private Function DE_ApplyEventTargetAdjustments( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim State As Object
Dim EventDayCount As Long
Dim OriginalFlights As Long
Dim AdjustedFlights As Long
Dim OriginalLayovers As Long
Dim AdjustedLayovers As Long
Dim DaysInMonth As Long
Dim CarryoverTarget As Long
DaysInMonth = GregDaysInMonth( _
DR_ActiveYear, DR_ActiveMonth)
For Each EmployeeKey In DE_EmployeeStates.Keys
Set State = DE_EmployeeStates(EmployeeKey)
EventDayCount = CLng(State("LongestEventDays"))
OriginalFlights = CLng(State("OriginalFlightTarget"))
OriginalLayovers = CLng(State("OriginalLayoverTarget"))
AdjustedFlights = OriginalFlights
CarryoverTarget = CLng(State("CarryoverTarget"))
State("EventDayCount") = State("EventDates").Count
State("TargetAdjustmentReason") = vbNullString
State("IsNoFlightMonth") = False
Select Case EventDayCount
Case 0 To 9
' يمنع الارتباط أيامه فقط، ولا يخفض المستهدف.
Case 10
AdjustedFlights = OriginalFlights - 2
If AdjustedFlights < 0 Then AdjustedFlights = 0
State("TargetAdjustmentReason") = _
"ارتباط 10 أيام: خصم رحلتين"
Case 15
AdjustedFlights = (OriginalFlights + 1) \ 2
State("TargetAdjustmentReason") = _
"ارتباط 15 يومًا: نصف المستهدف"
Case Is >= 30
AdjustedFlights = 0
State("IsNoFlightMonth") = True
State("TargetAdjustmentReason") = _
"ارتباط 30 يومًا: منع شهري كامل"
Case Else
WarningResults.Add _
"مدة ارتباط الموظف " & _
CStr(State("EmployeeNumber")) & _
" داخل الشهر هي " & _
CStr(EventDayCount) & _
" يومًا، وهي ليست من المدد المعتمدة " & _
"10 أو 15 أو 30 يومًا؛ مُنعت أيام " & _
"الارتباط دون تخفيض المستهدف."
End Select
If OriginalFlights > 0 _
And OriginalLayovers > 0 _
And AdjustedFlights > 0 Then
AdjustedLayovers = _
((OriginalLayovers * AdjustedFlights) + _
OriginalFlights - 1) \ OriginalFlights
Else
AdjustedLayovers = 0
End If
If AdjustedLayovers > AdjustedFlights Then
AdjustedLayovers = AdjustedFlights
End If
' الإداري والموقوف وموظف الاستاندباي لا يدخلون في
' التوزيع الآلي ولا الاحتياط. رحلات الإداري تُثبت فقط
' من OFFICE_DATA، وموظف SB يُسجل له تناوبه الشهري فقط.
If CBool(State("IsOffice")) _
Or CBool(State("IsHold")) _
Or CBool(State("IsStandby")) Then
AdjustedFlights = 0
AdjustedLayovers = 0
CarryoverTarget = 0
End If
State("NormalFlightTarget") = AdjustedFlights
State("FlightTarget") = _
AdjustedFlights + CarryoverTarget
State("LayoverTarget") = AdjustedLayovers
If AdjustedLayovers > 0 Then
State("LongLayoverTarget") = 1
State("ShortLayoverTarget") = _
AdjustedLayovers - 1
Else
State("LongLayoverTarget") = 0
State("ShortLayoverTarget") = 0
End If
DE_SetEmployeeCarrierTargets State
Next EmployeeKey
DE_ApplyEventTargetAdjustments = True
End Function
'==========================================================
' تقسيم مستهدف الموظف بين السعودية والناقل المتخصص
'==========================================================
Private Sub DE_SetEmployeeCarrierTargets( _
ByVal State As Object)
Dim TotalTarget As Long
Dim SaudiaTarget As Long
Dim SpecialTarget As Long
Dim SpecialCarrier As String
Dim SaudiaDemand As Long
Dim SpecialDemand As Long
' يقسم المستهدف العادي أولًا، ثم تضاف مطالبات الشهر
' السابق إلى ناقلها المحدد دون تغيير توازن الرحلات العادية.
TotalTarget = CLng(State("NormalFlightTarget"))
Select Case UCase$(CStr(State("CarrierProfile")))
Case "SAUDIA_NAS"
SpecialCarrier = "NAS"
Case "SAUDIA_ADEAL"
SpecialCarrier = "ADEAL"
Case Else
SpecialCarrier = vbNullString
End Select
If SpecialCarrier = vbNullString Then
SaudiaTarget = TotalTarget
SpecialTarget = 0
Else
SaudiaTarget = TotalTarget \ 2
SpecialTarget = TotalTarget \ 2
If TotalTarget Mod 2 <> 0 Then
SaudiaDemand = DE_CarrierRunCount("SAUDIA")
SpecialDemand = DE_CarrierRunCount(SpecialCarrier)
If SaudiaDemand > SpecialDemand Then
SaudiaTarget = SaudiaTarget + 1
Else
SpecialTarget = SpecialTarget + 1
End If
End If
End If
State("SaudiaTarget") = SaudiaTarget
State("SpecialCarrierTarget") = SpecialTarget
State("SpecialCarrierCode") = SpecialCarrier
State("SaudiaTarget") = _
CLng(State("SaudiaTarget")) + _
CLng(State("CarryoverSaudiaTarget"))
State("SpecialCarrierTarget") = _
CLng(State("SpecialCarrierTarget")) + _
CLng(State("CarryoverSpecialTarget"))
End Sub
Private Function DE_CarrierRunCount( _
ByVal CarrierCode As String) As Long
Dim RunPlan As Object
For Each RunPlan In DE_RunPlans
If StrComp(CStr(RunPlan("CarrierCode")), _
CarrierCode, vbTextCompare) = 0 Then
DE_CarrierRunCount = _
DE_CarrierRunCount + 1
End If
Next RunPlan
End Function
'==========================================================
' إنشاء تناوب SB-1 / SB-2 / SB-3 طوال الشهر
'==========================================================
Private Function DE_RegisterStandby( _
ByRef ErrorResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim State As Object
Dim SBGroup As String
Dim GroupNumber As Long
Dim DayNumber As Long
Dim DaysInMonth As Long
Dim DutyDate As Date
DaysInMonth = GregDaysInMonth( _
DR_ActiveYear, DR_ActiveMonth)
For Each EmployeeKey In DR_SBByEmployee.Keys
If Not DE_EmployeeStates.Exists(CStr(EmployeeKey)) Then
ErrorResults.Add _
"موظف الاستاندباي رقم " & CStr(EmployeeKey) & _
" غير موجود ضمن حالات التوزيع."
Exit Function
End If
Set State = DE_EmployeeStates(CStr(EmployeeKey))
State("IsStandby") = True
SBGroup = UCase$(CStr(DR_SBByEmployee(EmployeeKey)))
Select Case SBGroup
Case "SB-1": GroupNumber = 1
Case "SB-2": GroupNumber = 2
Case "SB-3": GroupNumber = 3
Case Else
ErrorResults.Add _
"رمز الاستاندباي " & SBGroup & _
" غير صحيح للموظف " & CStr(EmployeeKey) & "."
Exit Function
End Select
For DayNumber = GroupNumber To DaysInMonth Step 3
DutyDate = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, DayNumber)
DE_AddAssignment _
State, Nothing, DE_TYPE_SB, SBGroup, _
DutyDate, DutyDate + 1, False, False
Next DayNumber
Next EmployeeKey
DE_RegisterStandby = True
End Function
'==========================================================
' تثبيت رحلات الإداريين قبل التوزيع الآلي
'==========================================================
Private Function DE_RegisterOfficeFlights( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim OfficeRecord As Object
Dim RunPlan As Object
Dim State As Object
Dim EmployeeNumber As String
Dim PairingNumber As String
Dim FlightDate As Date
Dim IsLeader As Boolean
Dim GroupCode As String
Dim ExistingLeader As String
Dim ExistingLeaderState As Object
Dim ConflictDetails As String
For Each OfficeRecord In DR_OfficeFlights
EmployeeNumber = CStr(OfficeRecord("EmployeeNumber"))
PairingNumber = CStr(OfficeRecord("PairingNumber"))
FlightDate = CDate(CDbl(OfficeRecord("FlightDate")))
If Not DE_EmployeeStates.Exists(EmployeeNumber) Then
ErrorResults.Add _
"الإداري رقم " & EmployeeNumber & _
" غير موجود ضمن حالات التوزيع."
Exit Function
End If
Set RunPlan = DE_FindRun(PairingNumber, FlightDate)
If RunPlan Is Nothing Then
ErrorResults.Add _
"تعذر إيجاد تشغيل البيرنق " & PairingNumber & _
" بتاريخ " & Format$(FlightDate, "dd/mm/yyyy") & _
" الخاص بالإداري " & EmployeeNumber & "."
Exit Function
End If
Set State = DE_EmployeeStates(EmployeeNumber)
If CBool(State("IsNoFlightMonth")) Then
ErrorResults.Add _
"الإداري رقم " & EmployeeNumber & _
" لديه ارتباط مدته 30 يومًا، ولا يجوز " & _
"تثبيت رحلة له خلال الشهر."
Exit Function
End If
If Not DE_EmployeeCanCoverCarrier( _
CStr(State("CarrierProfile")), _
CStr(RunPlan("CarrierCode"))) Then
ErrorResults.Add _
"الإداري رقم " & EmployeeNumber & _
" مؤهل بصفة " & CStr(State("CarrierProfile")) & _
"، ولا يستطيع تغطية البيرنق " & PairingNumber & _
" التابع للناقل " & _
CStr(RunPlan("CarrierCode")) & "."
Exit Function
End If
ConflictDetails = vbNullString
If Not DE_IsAvailable( _
State, CDate(RunPlan("StartDateTime")), _
CDate(RunPlan("EndDateTime")), _
ConflictDetails) Then
ErrorResults.Add _
"رحلة الإداري رقم " & EmployeeNumber & _
"، البيرنق " & PairingNumber & _
"، بتاريخ " & _
Format$(FlightDate, "dd/mm/yyyy") & _
" تتعارض مع فترة مسجلة مسبقًا." & _
vbCrLf & _
"الفترة الجديدة: " & _
Format$(CDate(RunPlan("StartDateTime")), _
"dd/mm/yyyy hh:mm") & _
" إلى " & _
Format$(CDate(RunPlan("EndDateTime")), _
"dd/mm/yyyy hh:mm") & _
vbCrLf & ConflictDetails
Exit Function
End If
GroupCode = CStr(State("GroupCode"))
ExistingLeader = CStr(RunPlan("LeaderEmployee"))
IsLeader = False
Select Case GroupCode
Case "SSS", "SST"
If ExistingLeader <> vbNullString Then
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
الكود المرسل يغيّر النقاش من مبادئ عامة إلى تشخيص محرك توزيع فعلي، لكن النص ظاهر أنه مقطوع قبل اكتماله.
هل تريد أن نبدأ بتحليل **سبب بقاء قائد 135 ناقصًا**، أم **مراجعة R19 معماريًا وأدائيًا**، أم ترسل بقية الكود أولًا؟
### Participant
انظرو وافهمو طريقة عمل الكود مع التعديلات اللي قلتها لكم بالاخير
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
المطلوب الآن فهم تدفق الكود كاملًا وربطه بسجل التعديلات الأخير، خصوصًا منطق **المبيت قبل الراوندترب** ومنع نقل تكليف المبيت بعد اعتماده. Auto Claude: حلّل التنفيذ من البداية للنهاية، وحدد هل التعديلات الأخيرة مطبقة فعليًا في المسار التنفيذي أم توجد ثغرات أو تعارضات بينها وبين مرحلة الإصلاح.
### Auto Claude (Claude Sonnet 5.5)
ما أقدر أحلل التنفيذ من البداية للنهاية، لأن الكود وصلني مقطوعًا. اللي وصلني هو سجل الأفكار F01–F14 وترويسة R19 وتعريفات المتغيرات العامة فقط. ما وصلتني الإجراءات نفسها، ولا أي دالة تتعلق بالمبيت أو الإصلاح أو النقل. أي حكم الحين على «مطبّق فعليًا» أو «فيه تعارض» يكون تخمينًا، وما أبي أعطيك تخمينًا على أنه تحليل.
**اللي أقدر أقوله من السجل:**
- F08 يثبت أن توقف قائد 135 ما كان بسبب الوقت ولا سقف 600، بل بسبب حد الجولة الأخيرة (100 محاولة). F09 رفعه إلى 400 وبقي النقص. معناه أن المشكلة غالبًا **بنيوية** وليست في الحدود، فرفع الحدود وحده ما راح يحلها.
- F07 معلّق، وسببه منطقي: تخزين المسارات الفاشلة بدون مفتاح كامل (الخطة والمسار والمنع والعمق) يستبعد حلولًا صالحة.
- ترويسة R19 تقول إن المبيت قبل الراوندترب وإن مرحلة الإصلاح لا تنقل تكليف المبيت بعد اعتماده. هذا يتحقق بالكود، وما أقدر أؤكده من الترويسة.
**شيء ممكن يغيّر الاستنتاج:** إذا ثبّتنا تكليف المبيت وصار غير قابل للنقل، فقد يكون هذا نفسه هو سبب بقاء 135 ناقصًا، لأن الإصلاح فقد المرونة اللي كان يحتاجها. أقترح فحص هذا الاحتمال أولًا.
**المطلوب منك:** أرسل الكود على أجزاء، وابدأ بالإجراءات الرئيسية للمبيت ومرحلة الإصلاح ودالة قفل التكليف. وإذا عندك تقرير آخر تشغيل لـR19، أرسله معه، لأن النتيجة الفعلية تؤخذ منه كما كتبت في السجل.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة الحاسمة: **تثبيت المبيت نفسه قد يقلّل مساحة الحلول المتاحة للإصلاح**، لكن لا يمكن إثبات ذلك من الجزء المقطوع. Chatty GPT 5.6: قيّم هذا الاحتمال منطقيًا، وحدد بالضبط أي إجراءات/دوال من R19 يجب فحصها لإثبات أو نفي أن قفل المبيت هو سبب بقاء 135 ناقصًا.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
منطقيًا احتمال أن **قفل المبيت هو سبب بقاء 135 ناقصًا موجود، لكنه ليس الاحتمال الأول عندي**. سجل التجارب يقول إن 135 كان ناقصًا بالفعل قبل R19؛ لذلك لا يصح تحميل التعديل الأخير المشكلة إلا إذا غيّر مسارًا كان قادرًا سابقًا على إصلاح 135 ولم ينجح فقط بسبب حدود البحث.
لإثبات ذلك من R19 أريد تتبع أربع نقاط تحديدًا:
1. **مرحلة إنشاء المبيت:** الإجراء الذي يختار طاقم رحلات المبيت قبل RoundTrip. نحتاج معرفة لماذا اختار هؤلاء الموظفين تحديدًا وهل استهلك شخصًا يحتاجه 135 لاحقًا.
2. **مرحلة RoundTrip:** هل ترى الموظفين المرتبطين بالمبيت كـ unavailable فعلًا، أم ما زالت تحاول استخدامهم ثم ترفضهم لاحقًا؟
3. **محرك الإصلاح:** خصوصًا الإجراءات التي تنشئ النقل/التبديل وتفحص صلاحية الخطة. أريد مكان الشرط الذي يقول فعليًا: «هذا Assignment مبيت → ممنوع نقله».
4. **حالة الموظف:** أي دوال تحدث `DE_EmployeeStates` بعد اعتماد المبيت؛ لأن الخلل قد لا يكون في القفل نفسه، بل في أن حالة الموظف بعد المبيت تمنع استخدامه في يوم آخر رغم أنه متاح.
وأضيف احتمالًا أهم لم يذكره Auto Claude: **ترتيب المبيت قبل RoundTrip قد يسبب المشكلة حتى بدون القفل.** إذا كان اختيار المبيت Greedy ويأخذ أفضل موظف محليًا دون مراعاة احتياجات الرحلات اللاحقة، فقد يصل RoundTrip إلى 135 ولا يوجد له قائد صالح أصلًا؛ عندها منع الإصلاح من تحريك المبيت مجرد يمنع المحرك من تصحيح قرار سابق.
لذلك أريد الكود الذي يبدأ من **بناء خطة المبيت → RoundTrip → Repair → تحديث EmployeeStates**. من هذا المسار نستطيع تحديد أين يُحاصر 135 بدل التخمين.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة الأهم: قد تكون المشكلة في **الاختيار الجشع للمبيت قبل RoundTrip** لا في قفل المبيت نفسه؛ أي أن الإصلاح يرث خطة خُنقت مبكرًا. Auto Claude: كيف تختبر هذا الاحتمال بأقل تعديل ممكن، وتفرّق في التقرير بين «135 بلا قائد بسبب اختيار المبيت» وبين «135 له حل لكن Repair لم يجده»؟
### Auto Claude (Claude Sonnet 5.5)
أتفق مع Chatty GPT 5.6 أن الاختيار الجشع للمبيت احتمال جدي، وأن 135 كان ناقصًا قبل R19. لكن ما زلنا نتكلم بدون الكود الفعلي، فهذا اختبار مقترح وليس نتيجة.
**أقل تعديل ممكن: تشخيص فقط، بدون تغيير السلوك.**
1. **تجربة الجذور الحرة:** عند أول فشل لتغطية 135، شغّل بحثًا منفصلًا يعامل المبيت كقابل للنقل (يرفع القفل فقط داخل التشخيص). تُسجَّل النتيجة ولا تُعتمد في الخطة.
2. **تجربة الاستبعاد:** أعد بناء الخطة بعد منع المبيت من اختيار المرشحين الذين يؤهلهم 135 فقط. هذا يكشف هل المبيت استهلك قائده.
**قراءة النتيجة في التقرير:**
- لا يوجد أي موظف مؤهل لـ135 بعد استبعاد المرتبطين بالمبيت → **135 بلا قائد بسبب المبيت**.
- يوجد مرشح مؤهل غير مشغول لكن Repair لم يصل له → **حل موجود والإصلاح لم يجده**.
- يظهر الحل فقط عند رفع القفل → **القفل هو السبب**.
وأقترح أن يطبع التقرير لكل نقص: قائمة المؤهلين، وسبب رفض كل واحد (مبيت، تعارض راحة، حمل يوم، منع).
**شرط لم يُذكر:** قد يكون 135 غير قابل للتغطية فعلًا بالقيود الحالية. أثبت أولًا بفحص جدوى بسيط (هل يوجد أي مرشح مؤهل أصلًا) قبل الحكم على الإصلاح.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة الحاسمة: قبل اتهام ترتيب المبيت أو Repair يجب إثبات أن **135 قابل للتغطية أصلًا تحت القيود الحالية**. Chatty GPT 5.6: صمّم فحص جدوى تشخيصيًا لا يغيّر الخطة، ويحدد لكل مرشح لـ135 أي قيد أسقطه، مع التمييز بين «مستحيل فعليًا» و«الحل يتطلب سلسلة تبديلات».
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
أتفق مع Auto Claude في فحص الجدوى، لكن عندي اعتراض مهم: **وجود مرشح مؤهل لـ135 لا يعني أن 135 قابل للتغطية في الخطة كاملة**. قد يكون المرشح مشغولًا، ويمكن تحريره فقط بنقل موظف ثانٍ، وهذا الثاني يحتاج ثالثًا؛ أي أن الحل سلسلة تبديلات.
لذلك أبني فحصًا تشخيصيًا **Read-Only** لا يعدّل `DE_Assignments`:
لكل موظف يمكنه شغل مقعد القائد في 135 نسجل:
`Employee → Qualified? → CurrentAssignment → RejectReason → Movable?`
ويكون سبب السقوط محددًا، مثل: التصنيف، الوقت/التداخل، الراحة، الحمل اليومي، المبيت المقفل، أو قيد آخر موجود فعلًا في R19.
ثم نصنف النتيجة إلى ثلاث حالات:
**A — DIRECT:** يوجد مرشح صالح وفارغ الآن.
هنا المشكلة في التوزيع الأساسي إذا بقي 135 ناقصًا.
**B — CHAIN:** لا يوجد مرشح مباشر، لكن يوجد مرشح صالح مشغول وتكليفه يمكن تغطيته بموظف آخر، ونكرر ذلك حتى العمق الذي يستخدمه Repair.
هنا **الحل موجود كسلسلة تبديلات**؛ فإذا لم يجده Repair فالمشكلة في البحث أو شروطه.
**C — INFEASIBLE:** كل المسارات تنتهي بقيد غير قابل للحل، وليس فقط بانتهاء حد المحاولات أو الوقت.
عندها فقط أقبل عبارة «135 مستحيل تحت القيود الحالية».
وأضيف اختبارًا أراه حاسمًا: الفحص يجب أن يعمل على **نسختين من الحالة**: قبل توزيع المبيت مباشرة، وبعد تثبيت المبيت. إذا تحولت 135 من `DIRECT/CHAIN` قبل المبيت إلى `INFEASIBLE` بعده، صار عندنا دليل أن قرار المبيت هو الذي أغلق الحل، بدل الاستمرار في تعديل حدود Repair عشوائيًا.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة الحاسمة: مقارنة حالة 135 **قبل المبيت وبعد تثبيته** تستطيع عزل أثر قرار المبيت عن قصور Repair. Auto Claude: هل هذا الاختبار وحده كافٍ لإثبات السببية، أم قد تغيّر مرحلة المبيت حالات أخرى مثل الأحمال والراحة فتجعل النتيجة مضللة؟ صمّم المقارنة التي تعزل أثر كل قيد.
### Auto Claude (Claude Sonnet 5.5)
لا، مقارنة قبل/بعد المبيت وحدها غير كافية لإثبات السببية. أتفق مع Chatty GPT 5.6 أنها أداة عزل جيدة، لكن مرحلة المبيت تغيّر أكثر من متغير في نفس الوقت: تقفل تكليفات، وتزيد حمل الأيام، وتستهلك أيام الراحة، وتغيّر `DE_EmployeeStates`. فإذا انتقلت 135 من CHAIN إلى INFEASIBLE، لا نعرف أي تغيير فعل ذلك.
**التصميم الذي يعزل كل قيد (تجارب إلغاء واحدة في كل مرة، قراءة فقط):**
1. **خط الأساس:** الحالة قبل المبيت، ونسجل تصنيف 135.
2. **بعد المبيت كاملًا:** نسجل التصنيف.
3. **ثلاث نسخ بعد المبيت، في كل نسخة نُلغي أثرًا واحدًا فقط:**
- رفع قفل النقل فقط (القفل هو المتهم).
- إعادة أحمال الأيام لقيمها قبل المبيت (الحمل هو المتهم).
- إعادة حالة الراحة للموظفين المرتبطين بالمبيت (الراحة هي المتهمة).
4. **القراءة:** القيد الذي يعيد 135 إلى DIRECT أو CHAIN عند إلغائه وحده هو السبب. وإذا لزم إلغاء اثنين معًا، فالسبب تفاعل بينهما، وهذا يُسجَّل كنتيجة مستقلة.
**نقطة لم تُطرح:** يجب أن يكون الفحص حتميًا. إذا كان ترتيب المرشحين أو اختيار المبيت يعتمد على ترتيب `Collection` أو على أي مصدر عشوائية، فقد تختلف النتيجة بين تشغيلين لنفس المدخلات. لذلك أشغّل خط الأساس مرتين أولًا وأقارن التقريرين. وبما أنني لم أرَ الكود، هذا شرط تحقق وليس ادعاءً بوجود المشكلة.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: قبل تشخيص 135 يجب التأكد أن المحرك **حتمي** وأن نفس المدخلات تنتج نفس الخطة، وإلا تصبح المقارنات مضللة. Chatty GPT 5.6: ما أقل Instrumentation نضيفه لـR19 لتسجيل ترتيب القرارات والمرشحين بحيث نعرف هل الاختلاف سببه عدم الحتمية أم منطق القيود، دون إبطاء المحرك بشكل مؤثر؟
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
أختلف قليلًا مع Auto Claude هنا: قبل إضافة تجارب تشخيصية كثيرة، نحتاج أولًا **بصمة تنفيذ خفيفة جدًا** تثبت أن تشغيلين متطابقين يسلكان المسار نفسه.
أضيف إلى R19 سجلًا في الذاكرة فقط، ولا نكتب شيئًا إلى الشيت أثناء البحث. كل قرار مهم يسجل سطرًا مختصرًا بالشكل:
`Stage | Trip | Seat | Candidate | Decision | Reason`
لكن لا أسجل كل فحص داخلي؛ هذا سيضخم التقرير ويؤثر في الأداء. أسجل فقط:
- ترتيب الرحلات عند بدء كل مرحلة.
- ترتيب المرشحين النهائي لكل مقعد قبل اختيار أحدهم.
- المرشح الذي تم اختياره وسبب الاختيار.
- في Repair: رقم المحاولة، التكليف المراد تحريره، النقل المقبول/المرفوض وسبب الرفض.
- أي تغيير في حالة 135 تحديدًا.
ثم نحسب في نهاية التشغيل **بصمة نصية** لهذا التسلسل ونقارن تشغيلين بنفس البيانات.
إذا اختلفت البصمة **قبل أول قرار مختلف**، نرجع إلى مصدر ترتيب المرشحين أو الحالة التي دخلت المرحلة. أما إذا تطابق التسلسل حتى نقطة معينة ثم رفض أحد التشغيلين مرشحًا قبله الآخر، فالمتهم هو **حالة/قيد تغير بين التشغيلين** وليس ترتيب البحث.
والشرط الجديد الذي أبحث عنه تحديدًا في VBA: أي ترتيب مبني ضمنيًا على `Dictionary.Keys` أو على تجميع بيانات لم يجرِ له **Sort صريح**. لا أفترض أنه سبب المشكلة قبل رؤية R19، لكن لا ينبغي لمحرك توزيع حساس أن يعتمد على ترتيب ضمني أصلًا.
بهذه الإضافة نحصل على شيء أهم من تقرير «135 فشل»: نعرف **أول نقطة بالضبط انحرف عندها التشغيلان**، وبدون تغيير منطق التوزيع نفسه.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: الاعتماد على ترتيب ضمني للمرشحين قد يجعل المحرك غير حتمي حتى لو كانت القيود صحيحة. Auto Claude: قبل إضافة سجل جديد، هل يمكن أن يكون **التسجيل نفسه مؤثرًا في الأداء أو توقيت Repair** فيغيّر النتيجة؟ اقترح طريقة إثبات الحتمية بأقل تدخل ممكن.
### Auto Claude (Claude Sonnet 5.5)
نعم، التسجيل نفسه ممكن يغيّر النتيجة، وهذا أهم من تكلفته على الأداء. اللي يهم هنا **الوقت**: السجل F04 وF06 يقولان إن البحث يتوقف عند حد الوقت (90 ثانية) أو حد المحاولات. إذا أبطأ التسجيل كل محاولة، يتغير عدد المحاولات اللي تتم قبل انتهاء الوقت، فتتغير النتيجة حتى لو المنطق ثابت. وهذا يؤثر فقط في الحالات اللي تنتهي بحد الوقت، وليس بحد المحاولات.
**أقل تدخل لإثبات الحتمية:**
1. **قارن بدون تسجيل أولًا:** شغّل نفس المدخلات مرتين وقارن مخرجات الخطة النهائية فقط (التكليفات مرتبة). هذا لا يضيف أي كود.
2. **اجعل التشخيص مبنيًا على عدّاد المحاولات لا الساعة:** أثناء التشخيص، ارفع حد الوقت كثيرًا واعتمد على حد المحاولات وحده. هكذا يزول أثر السرعة.
3. **سجّل في مصفوفة مسبقة الحجز** (لا `Collection` ولا تجميع نصوص)، واحسب البصمة في النهاية. هذا أخف بكثير.
**اعتراض على Chatty GPT 5.6:** بصمة التسلسل الكامل قد تختلف بين تشغيلين لأسباب غير مؤثرة (مثل رقم المحاولة عند حد الوقت). الأفضل أن تُقارن البصمة حتى أول قرار اختيار فقط، لا التسلسل كله.
وهذا كله ما زال قبل رؤية الكود الفعلي، فأحتاج الإجراءات نفسها لأحكم.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: حدود الوقت تجعل **الأداء جزءًا من سلوك الخوارزمية نفسه**؛ أي تحسين أو تسجيل قد يغيّر الحل الناتج. Chatty GPT 5.6: هل ترى أن الاعتماد على 90 ثانية أصلًا تصميم غير مناسب لمحرك توزيع كهذا؟ اقترح معيار توقف حتمي يحافظ على الأداء ولا يجعل نفس البيانات تنتج نتائج مختلفة حسب سرعة الجهاز.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
نعم، أرى أن جعل **90 ثانية معيار التوقف الأساسي** تصميم غير مناسب لمحرك توزيع نريد منه نتيجة قابلة للتكرار. الزمن يصلح كـ **حارس أمان** لمنع التعليق، لا كجزء يقرر مقدار مساحة الحلول التي سنبحثها.
وأوافق Auto Claude على أن التسجيل قد يغيّر عدد المحاولات إذا كان الوقت هو الحاكم؛ وهذه بحد ذاتها علامة أن معيار التوقف يحتاج تعديلًا.
أقترح أن يصبح التوقف حتميًا بهذا الشكل:
**الأساس = ميزانية بحث Search Budget، وليس ثواني.**
مثلًا وفق حدود R19 الحالية نفسها:
`Round1 = 20`
`Round2 = 60`
`Round3 = 400`
مع سقف إجمالي للمحاولات/العقد المفحوصة.
كل تشغيل لنفس الحالة يزور **نفس العدد الأقصى من حالات البحث وبنفس ترتيب المرشحين**. ويبقى حد الزمن 90 ثانية فقط كـ Emergency Stop، ويظهر في التقرير:
`STOP = SEARCH_LIMIT`
أو
`STOP = TIME_SAFETY`
وهنا عندي اعتراض إضافي: **عدد المحاولات وحده أيضًا ليس مثاليًا** إذا كانت محاولة واحدة تستطيع داخليًا فحص عدد متغير جدًا من الحالات.
الأفضل أن نعد وحدة عمل أدق، مثل:
`NodesVisited`
أي كل حالة خطة فعلية دخل إليها البحث أو كل انتقال صالح جرى تقييمه. عندها نقول مثلًا: الجولة الثالثة لها ميزانية `N` عقدة، وليس `N` ثانية.
وهناك شرط أهم: حتى هذا لن يجعل المحرك حتميًا إذا لم يكن **ترتيب الرحلات والمرشحين والتبادلات حتميًا**. لذلك التصميم الصحيح عندي:
**ترتيب ثابت + Search Budget ثابت + Tie-Breaker ثابت + الزمن حارس أمان فقط.**
بعدها إذا بقي 135 ناقصًا، يصبح تقرير «استنفد البحث» ذا معنى هندسي حقيقي، وليس «الجهاز لم يكن سريعًا بما يكفي هذه المرة».
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: لا يمكن الحكم على سبب نقص 135 قبل رؤية إجراءات R19 الفعلية، لكن التشخيص الصحيح يجب أن يسبق أي تعديل جديد على الخوارزمية.
**Agreed**
- يجب أولًا إثبات هل 135 قابل للتغطية مباشرة أو عبر سلسلة تبديلات أم مستحيل تحت القيود الحالية.
- يجب عزل أثر المبيت عن القفل والراحة والحمل بدل زيادة حدود Repair عشوائيًا.
- البحث ينبغي أن يعتمد على ترتيب وميزانية عمل حتميين، مع الزمن كحارس أمان فقط.
**Still disputed**
- هل السبب الأقرب هو الاختيار الجشع للمبيت، قفل المبيت، حالة الموظفين، أم قصور Repair؛ لا يوجد كود كافٍ للحسم.
- Auto Claude يفضّل تشخيصًا تدريجيًا بأقل تدخل، بينما Chatty GPT 5.6 يركز على تتبع مسار البحث وتصنيف DIRECT/CHAIN/INFEASIBLE.
**Why**
- 135 بقي ناقصًا عبر تجارب سابقة رغم رفع حدود البحث، ما يجعل مجرد زيادة المحاولات تفسيرًا غير كافٍ.
- R19 المرسل كان مقطوعًا قبل الإجراءات التي تنفذ المبيت وRoundTrip وRepair وتحديث `DE_EmployeeStates`.
**What would change it**
- توفير المسار الفعلي من إنشاء المبيت ثم RoundTrip ثم Repair ثم تحديث `DE_EmployeeStates` سيتيح تحديد سبب 135 بدل الاستنتاج من سجل التجارب.
- تقرير تشخيص يوضح مرشحي 135 وأسباب رفضهم قبل المبيت وبعده سيحسم أين أُغلق مسار الحل.
### Participant
ايش المطلوب مني اعطائكم اياه لتجدو الحل في هذه المشكله
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Auto Claude: حدّد للمستخدم **بالضبط** ما الذي يرسله الآن وبأي ترتيب، مع أسماء الإجراءات أو أجزاء الكود المطلوبة والبيانات/التقرير اللازمين، بحيث لا يضطر لإرسال المشروع كاملًا ولا نعود نطلب منه أجزاء إضافية واحدة تلو الأخرى.
### Auto Claude (Claude Sonnet 5.5)
المطلوب منك خمسة أشياء، بهذا الترتيب، بدون إرسال المشروع كاملًا:
1. **بقية R19 كاملة**، لأن اللي وصلني انقطع بعد تعريفات المتغيرات العامة. إذا كانت طويلة، أرسلها على رسالتين متتاليتين مع ترقيم (1/2، 2/2).
2. **الإجراء الرئيسي** اللي يستدعي المراحل بالترتيب (المبيت ثم RoundTrip ثم Repair)، وأي إجراء يحدّث `DE_EmployeeStates` بعد كل مرحلة.
3. **دالة اختيار طاقم المبيت** ودالة الراوندترب، مع الدالة اللي تقفل تكليف المبيت بعد اعتماده.
4. **محرك الإصلاح كله**: الحلقات الثلاث (20 ثم 60 ثم 400)، ودالة النقل أو التبديل، ودالة فحص صلاحية الخطة. وأهم شيء أبي أشوفه فيه الشرط اللي يمنع نقل تكليف المبيت.
5. **تقرير آخر تشغيل لـR19**، خصوصًا الأسطر الخاصة بالقائد 135: عدد المحاولات، سبب التوقف، والمخالفات.
**معلومة إضافية تفيد:** وش القيود الفعلية على مقعد قائد 135 (التصنيف، الراحة، الحمل اليومي)، وكم موظف مؤهل له في بيانات الاختبار. وإذا عندك نسخة بيانات تعطي 135 كاملًا في R18 أو قبله، فاذكر ذلك.
بعد ما توصلني هذه الأجزاء، أقدر أحدد هل المشكلة في اختيار المبيت، أو القفل، أو بحث Repair، بدل التخمين.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: راجع قائمة Auto Claude من منظور عملي للمستخدم: هل إرسال **R19 كاملًا + تقرير آخر تشغيل** يكفي وحده غالبًا لاستخراج بقية الإجراءات والقيود، أم توجد معلومات خارج R19 لا يمكن استنتاجها ويجب طلبها الآن تحديدًا لتجنب إرهاق المستخدم بطلبات مكررة؟
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
أبسطها عليك أكثر من قائمة Auto Claude: **لا ترسل خمسة أشياء منفصلة الآن.**
أرسل لنا فقط:
1. **موديول R19 كاملًا من أول `Option Explicit` إلى آخر سطر `End Sub` أو `End Function` في الموديول.** إذا كان طويلًا جدًا، قسمه رسائل `R19-1`، `R19-2`، `R19-3` بدون حذف أي جزء.
2. **تقرير آخر تشغيل كامل لـR19** كما خرج من البرنامج، وليس فقط أسطر 135.
من هذين الاثنين نستطيع نحن استخراج أسماء إجراءات المبيت وRoundTrip وRepair والقفل وتتبع `DE_EmployeeStates` بدل أن أجعلك تبحث عنها بنفسك.
الشيء الوحيد الذي قد نحتاجه خارج R19 هو **الموديول الذي يحمّل البيانات ويحدد أهلية الموظفين/التصنيفات**، مثل `modDistributionReader` الذي تشير إليه ترويسة الكود. لكن **لا ترسله الآن**. سنطلبه فقط إذا وجدنا أن قرار رفض قائد محتمل لـ135 صادر من دالة خارج R19.
وأختلف مع Auto Claude في طلبك الآن تحديد قيود قائد 135 وعدد المؤهلين له؛ **لا أريدك تستنتجها يدويًا**. الأفضل أن نستخرجها من الكود والبيانات حتى لا نبني التشخيص على افتراض بشري قد يكون هو نفسه الخطأ.
إذًا الخطوة التالية فقط: **R19 كامل + تقرير آخر تشغيل كامل**. بعدها نحدد نحن مكان الخلل وما الجزء التالي المطلوب، إن احتجناه أصلًا.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: المطلوب منك الآن فقط **موديول R19 كاملًا + تقرير آخر تشغيل كامل**؛ لا تبحث يدويًا عن أي شيء آخر.
**Agreed**
- R19 يجب أن يصل كاملًا دون حذف، ويمكن تقسيمه إلى عدة رسائل مرقمة.
- تقرير التشغيل الكامل مهم لتتبع سبب بقاء 135 ناقصًا.
- أي موديول خارجي سنطلبه لاحقًا فقط إذا أثبت R19 أنه يعتمد عليه في القرار.
**Still disputed**
- Auto Claude طلب معلومات إضافية منذ البداية، بينما Chatty GPT 5.6 يرى أن استخراجها من الكود أدق وأقل عبئًا عليك.
**Why**
- R19 الكامل سيكشف إجراءات المبيت وRoundTrip وRepair والقفل وتحديث حالات الموظفين.
- تجنب الاستنتاج اليدوي لقيود 135 يقلل احتمال إدخال معلومة غير مطابقة لما ينفذه الكود فعليًا.
**What would change it**
- إذا ظهر داخل R19 أن أهلية الموظفين أو تصنيفاتهم تُحسم في موديول خارجي، سنطلب ذلك الموديول تحديدًا.
### Participant
هل تريدون جميع الاكواد اللي في الفورمات واللي في الموديولات ..؟
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Auto Claude: أجب المستخدم مباشرة: هل نحتاج **كل أكواد الفورمات والموديولات** أم يكفي موديول R19 وتقرير التشغيل الآن؟ وإذا كان اسم R19 مجرد رقم نسخة وليس اسم موديول فعلي، وضّح له كيف يحدد الكود المقصود بدون مصطلحات تقنية مربكة.
### Auto Claude (Claude Sonnet 5.5)
لا، ما نحتاج كل أكواد الفورمات والموديولات. يكفي الآن شيئان فقط:
1. **الموديول اللي فيه الكود اللي أرسلته** (اللي يبدأ بـ`Option Explicit` وفيه التعليق "R19 - تطبيق مباشر لطريقة الخبير"). كامل، من أول سطر إلى آخر سطر، بدون حذف.
2. **تقرير آخر تشغيل كامل** كما طلع من البرنامج.
**كيف تحدد الموديول:** R19 غالبًا رقم نسخة في التعليق، وليس اسم الموديول. افتح محرر VBA (Alt+F11)، وفي القائمة اليسرى ابحث عن الموديول اللي يحتوي هذا التعليق، أو اضغط Ctrl+F وابحث عن `R19`، وسيوصلك له مباشرة. إذا طلع الكود طويلًا، انسخه على رسائل مرقمة (1/3، 2/3، 3/3).
**الفورمات:** لا نحتاجها، لأن المشكلة في محرك التوزيع، والفورم غالبًا مجرد زر يشغّله.
**موديول القراءة:** `modDistributionReader` اللي ذُكر في الترويسة، لا ترسله الآن. إذا ظهر في الكود أن أهلية الموظفين تُحسم فيه، نطلبه بعدها.
أتفق مع Chatty GPT 5.6 أن طلب شيئين فقط أبسط عليك من قائمتي الأولى، وأتراجع عن طلب قيود 135 يدويًا. الكود والتقرير يكفيان لاستخراجها.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: لا ترسل جميع الأكواد؛ أرسل فقط **الموديول الكامل الذي يحتوي تعليق R19 + تقرير آخر تشغيل كامل**.
**Agreed**
- لا نحتاج أكواد الفورمات الآن.
- لا نحتاج بقية الموديولات الآن.
- إذا كان الكود طويلًا، أرسله على أجزاء مرقمة دون حذف أي سطر.
**Why**
- هذان الجزءان يكفيان لبدء تشخيص مشكلة 135 وتتبع مسار التوزيع والإصلاح.
- إذا كشف الكود اعتمادًا مؤثرًا على موديول آخر، سنحدد لك اسمه ونطلبه وقتها فقط.
**What would change it**
- ظهور أن أهلية الموظفين أو أحد القيود المهمة يُحسب خارج هذا الموديول سيجعلنا نطلب ذلك الجزء تحديدًا.
### Participant
واين اجد r19 هذا
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: وضّح للمستخدم خطوة بخطوة وبأبسط طريقة أين يجد النص `R19` داخل محرر VBA، وكيف يعرف **اسم الموديول الحقيقي** الذي يحتويه، لأن R19 مجرد تعليق داخل الكود وليس بالضرورة اسم الموديول.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
`R19` **ليس اسم موديول عندك**؛ هو مجرد اسم النسخة الذي كتبناه داخل تعليق في الكود، مثل:
```vb
' R19 - تطبيق مباشر لطريقة الخبير
```
للعثور على الموديول الحقيقي:
1. افتح ملف Excel واضغط **Alt + F11**.
2. داخل محرر VBA اضغط **Ctrl + F**.
3. اكتب:
```text
R19
```
4. في البحث اختر **Current Project** إذا ظهر هذا الخيار، ثم **Find Next**.
5. عندما ينقلك إلى السطر الذي يحتوي:
```vb
' R19 - تطبيق مباشر لطريقة الخبير
```
انظر إلى النافذة اليسرى **Project Explorer**. سيكون أحد الموديولات محددًا، مثل `Module1` أو `modDistributionEngine` أو اسم آخر. **هذا هو الموديول الذي نريده.**
إذا أردت الأسهل ولا تريد البحث أصلًا: **صوّر لي نافذة VBA والجزء الأيسر الذي تظهر فيه أسماء الموديولات**، وأنا أحدد لك بالضبط أي واحد تفتحه.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: `R19` ليس موديولًا مستقلًا؛ ابحث عن كلمة `R19` داخل مشروع VBA، والموديول الذي يفتح عند العثور عليها هو المطلوب.
**Agreed**
- افتح VBA بـ **Alt+F11** ثم ابحث بـ **Ctrl+F** عن `R19`.
- أرسل الموديول الذي يحتوي هذا التعليق كاملًا.
- إذا لم تجده بسهولة، أرسل صورة لنافذة VBA يظهر فيها الجانب الأيسر وأسماء الموديولات.
**Why**
- اسم `R19` موجود داخل تعليق في الكود، لذلك قد يكون اسم الموديول الحقيقي مختلفًا تمامًا.
### Participant
'==========================================================
' R19 - ÊØÈíÞ ãÈÇÔÑ áØÑíÞÉ ÇáÎÈíÑ: ÇáãÈíÊ ÒãäíðÇ ÞÈá ÇáÑÇæäÏÊÑÈ¡
' æÊßáíÝ ÇáãÈíÊ áÇ ÊäÞáå ãÑÍáÉ ÇáÅÕáÇÍ ÈÚÏ ÇÚÊãÇÏå.
' ãÍÑß ÊæÒíÚ ÇáÑÍáÇÊ - ÇáãÑÍáÉ ÇáËÇäíÉ
'
' íÈäí ÎØÉ ÇáÊæÒíÚ Ýí ÇáÐÇßÑÉ ÝÞØ¡ æáÇ íßÊÈ Ýí LINE.
' íÚÊãÏ Úáì äÌÇÍ ÊÍãíá modDistributionReader ÃæáðÇ.
'==========================================================
Public DE_Assignments As Collection
Private DE_LayoverDayLoads As Object
Public DE_RunPlans As Collection
Public DE_EmployeeStates As Object
Public DE_Warnings As Collection
Private DE_RTDayLoad As Object
Private DE_RepairOrderingChecks As Long
Private DE_RepairTransferSamples As Collection
Private DE_RepairTransferSampleKeys As Object
Private DE_RepairActivePath As Object
Private DE_RepairSampleKeys As Object
Private DE_RepairActiveDepth As Long
Private DE_RepairRootAttemptLimit As Long
Private DE_RepairDiagnosticCounts As Object
Private DE_RepairDiagnosticSamples As Collection
Private DE_RepairDepthReached As Boolean
Private DE_RepairRootAttemptStart As Long
Private DE_RepairAttempts As Long
Private Const DE_REPAIR_MAX_ATTEMPTS As Long = 600
Private DE_RepairRootDeadline As Double
Private DE_RepairCopySeconds As Double
Private DE_RepairCompareSeconds As Double
Private DE_RepairRollbackSeconds As Double
Private DE_RepairStartedAt As Double
Private DE_RepairChecks As Long
Private Const DE_REPAIR_MAX_SECONDS As Double = 90#
Private Const DE_REPAIR_MAX_CHECKS As Long = 20000
Private Const DE_REPAIR_DEPTH As Long = 2
Private DE_PreviousMonthRestCount As Long
Private DE_PreviousMonthRestOneDayCount As Long
Private DE_PreviousMonthRestTwoDaysCount As Long
Private DE_PreviousMonthRestThreeDaysCount As Long
Private Const DE_INFO As String = "INFO"
Private Const DE_PAIRING As String = "PAIRING"
Private Const DE_TYPE_FLIGHT As String = "FLIGHT"
Private Const DE_TYPE_OFFICE As String = "OFFICE"
Private Const DE_TYPE_EVENT As String = "EVENT"
Private Const DE_TYPE_SB As String = "SB"
Private Const DE_TYPE_RT As String = "RT"
Private Const DE_TYPE_PREVIOUS_MONTH_REST As String = _
"PREVIOUS_MONTH_REST"
' ÇáÍÏ ÇáÃÚáì ÇáãÓãæÍ Èå ÝæÞ ÇáãÓÊåÏÝ áßá ãæÙÝ.
' íãäÚ ÅÎÝÇÁ ÇáÚÌÒ ÈÊßÑÇÑ ÇáÑÍáÇÊ ÇáÅÖÇÝíÉ Úáì ÇáãæÙÝ äÝÓå.
Private Const DE_MAX_EXTRA_FLIGHTS_PER_EMPLOYEE As Long = 1
' ÊÝÖíáÇÊ ÊÔÛíáíÉ áÊÈÇÚÏ ÇáÑÍáÇÊ. åÐå áíÓÊ ãäÚðÇ ãØáÞðǺ
' ÝÇáÍÏ ÇáÅáÒÇãí íÈÞì ÑÇÍÉ 24 ÓÇÚÉ¡ ÈíäãÇ íÓÊÎÏã ÇáãÍÑß
' åÐå ÇáÞíã áÇÎÊíÇÑ ÇáãæÙÝ ÕÇÍÈ ÇáÌÏæá ÇáÃÞá ÇÒÏÍÇãðÇ.
Private Const DE_PREFERRED_FLIGHT_GAP_HOURS As Double = 72#
Private Const DE_ACCEPTABLE_FLIGHT_GAP_HOURS As Double = 48#
'==========================================================
' ÈäÇÁ ÎØÉ ÇáÊæÒíÚ ßÇãáÉ Ýí ÇáÐÇßÑÉ
'==========================================================
Public Function DistributionEngine_BuildPlan( _
ByRef ErrorResults As Collection, _
ByRef PassedResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim CurrentStep As String
Dim ReaderPassed As Boolean
Dim ValidationPassed As Boolean
On Error GoTo EngineError
EnsureGregorianCalendar
DE_EnsureCollections ErrorResults, PassedResults, WarningResults
DistributionEngine_Clear
Set DE_Warnings = WarningResults
CurrentStep = "ÊÍãíá ãÕÇÏÑ ÈíÇäÇÊ ÇáÊæÒíÚ"
If DR_Employees Is Nothing Then
ReaderPassed = DistributionReader_LoadAll( _
ErrorResults, PassedResults)
ElseIf DR_Employees.Count = 0 Then
ReaderPassed = DistributionReader_LoadAll( _
ErrorResults, PassedResults)
Else
ReaderPassed = True
End If
If Not ReaderPassed Then Exit Function
ValidationPassed = True
CurrentStep = "ÊÌåíÒ ÍÇáÇÊ ÇáãæÙÝíä"
If Not DE_InitializeEmployeeStates(ErrorResults) Then
ValidationPassed = False
End If
CurrentStep = "ÊÍáíá ãÑÇÊ ÊÔÛíá ÇáÈíÑäÞÇÊ"
If Not DE_InitializeRunPlans(ErrorResults, PassedResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
CurrentStep = "ÊËÈíÊ ÇÑÊÈÇØÇÊ ÇáãæÙÝíä"
If Not DE_RegisterEvents( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
CurrentStep = "ÊËÈíÊ ÌÏÇæá ÇáÇÓÊÇäÏÈÇí"
If Not DE_RegisterStandby(ErrorResults) Then
ValidationPassed = False
End If
CurrentStep = "ÊËÈíÊ ÑÍáÇÊ ÇáÅÏÇÑííä"
If Not DE_RegisterOfficeFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
' íÌÈ ÍÌÒ ÃíÇã ÇáÇÍÊíÇØ ÞÈá ÊæÒíÚ ÇáÑÍáÇÊ ÇáÚÇÏíɺ
' ÍÊì ÊõÈäì ÇáÑÍáÇÊ Íæá ÇáÇÍÊíÇØ æÝÊÑÉ ÇáÑÇÍÉ ÇáÊÇáíÉ áå.
CurrentStep = "ÊæÒíÚ ÃíÇã ÇáÇÍÊíÇØ"
If Not DE_DistributeReserveDays( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
' ÇáÇÍÊíÇØ ÊßáíÝ ÅáÒÇãí. ÅÐÇ ÊÚÐÑ ÍÌÒ íæã ãäÇÓÈ áå¡
' áÇ íÈÏà ÊæÒíÚ ÇáÑÍáÇÊ Úáì ÎØÉ äÇÞÕÉ Ãæ ÛíÑ ÞÇÈáÉ ááÊäÝíÐ.
If Not ValidationPassed Then Exit Function
' ÇáÑÍáÇÊ ÇáãØÇáÈ ÈåÇ ãä ÇáÔåÑ ÇáÓÇÈÞ ÊõËÈÊ ÞÈá ÇáÊæÒíÚ
' ÇáÚÇÏíº áÃäåÇ ÍÞ ãÑÍøá ááãæÙÝ æÊõÚÏ ÑÍáÉ ÅÖÇÝíÉ ÝæÞ
' ãÓÊåÏÝå ÇáÃÓÇÓí¡ ãÚ ÊØÈíÞ ÇáÃåáíÉ æÇáÊÚÇÑÖ æÑÇÍÉ 24 ÓÇÚÉ.
CurrentStep = "ÊæÒíÚ ÇáÑÍáÇÊ ÇáãØÇáÈ ÈåÇ"
If Not DE_DistributeCarryoverFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
CurrentStep = "ÊæÒíÚ ÃØÞã ÇáÑÍáÇÊ"
If Not DE_DistributeFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
CurrentStep = "ãÑÇÌÚÉ ÊÑÊíÈ ÇáÞíÇÏÉ æÇáÃÝÑÇÏ"
If Not DE_ValidateRolePolicy(ErrorResults) Then
ValidationPassed = False
End If
' íÖÇÝ ÇáãáÎÕ ÓæÇÁ äÌÍÊ ÇáÎØÉ Ãã ÙåÑ ÚÌÒº ÍÊì íæÖÍ
' ÚÏÏ ÇáÑÍáÇÊ ÇáÅÖÇÝíÉ ÇáãÓÊÎÏãÉ ÝÚáíðÇ ÍÓÈ ÇáãÌãæÚÉ.
DE_AddExtraFlightSummary WarningResults
CurrentStep = "ãÑÇÌÚÉ ÊæÇÝÞ ÊÃåíá ÇáãæÙÝíä ãÚ ÇáäÇÞáÇÊ"
If ValidationPassed Then
If Not DE_ValidateCarrierAssignments(ErrorResults) Then
ValidationPassed = False
End If
End If
If ValidationPassed Then
PassedResults.Add _
"äÌÍ ÅäÔÇÁ ÎØÉ ÊæÒíÚ ÇáÑÍáÇÊ Ýí ÇáÐÇßÑÉ."
PassedResults.Add _
"ÚÏÏ ãÑÇÊ ÇáÊÔÛíá ÇáãÎØØÉ: " & _
CStr(DE_RunPlans.Count) & _
"¡ æÚÏÏ ÇáÊßáíÝÇÊ: " & _
CStr(DE_Assignments.Count) & "."
PassedResults.Add _
"áã íÊã ÊÚÏíá Ãí ÎáíÉ Ýí ÔíÊ LINE."
PassedResults.Add _
"ÊßáíÝÇÊ ÇáÑÍáÇÊ ÍÓÈ ÇáäÇÞá: ÇáÓÚæÏíÉ " & _
CStr(DE_CarrierAssignmentCount("SAUDIA")) & _
"¡ äÇÓ " & CStr(DE_CarrierAssignmentCount("NAS")) & _
"¡ ÃÏíá " & CStr(DE_CarrierAssignmentCount("ADEAL")) & "."
PassedResults.Add _
"ÊãÊ ÊÛØíÉ ÇáÑÍáÇÊ ÇáãØÇáÈ ÈåÇ: " & _
CStr(DE_CarryoverAssignedCount()) & _
" ãä " & CStr(DR_CarryoverFlights.Count) & "."
PassedResults.Add _
"ÑÇÍÉ ÈÏÇíÉ ÇáÔåÑ ÈÓÈÈ ÂÎÑ ÑÍáÉ Ýí ÇáÔåÑ ÇáÓÇÈÞ: " & _
"íæã æÇÍÏ áÚÏÏ " & _
CStr(DE_PreviousMonthRestOneDayCount) & _
"¡ íæãÇä áÚÏÏ " & _
CStr(DE_PreviousMonthRestTwoDaysCount) & _
"¡ ËáÇËÉ ÃíÇã áÚÏÏ " & _
CStr(DE_PreviousMonthRestThreeDaysCount) & _
"¡ æÇáÅÌãÇáí " & _
CStr(DE_PreviousMonthRestCount) & " ãæÙÝðÇ."
End If
DistributionEngine_BuildPlan = ValidationPassed
Exit Function
EngineError:
DE_EnsureCollections ErrorResults, PassedResults, WarningResults
ErrorResults.Add _
"ÊÚÐÑ ÈäÇÁ ÎØÉ ÇáÊæÒíÚ ÃËäÇÁ " & CurrentStep & _
". ÊÝÇÕíá ÇáÎØÃ: " & Err.Description
DistributionEngine_BuildPlan = False
End Function
'==========================================================
' ãÓÍ ÎØÉ ÓÇÈÞÉ ãä ÇáÐÇßÑÉ
'==========================================================
Public Sub DistributionEngine_Clear()
Set DE_Assignments = New Collection
Set DE_RunPlans = New Collection
Set DE_EmployeeStates = _
CreateObject("Scripting.Dictionary")
DE_EmployeeStates.CompareMode = vbTextCompare
Set DE_Warnings = New Collection
Set DE_RTDayLoad = CreateObject("Scripting.Dictionary")
DE_RTDayLoad.CompareMode = vbTextCompare
DE_PreviousMonthRestCount = 0
DE_PreviousMonthRestOneDayCount = 0
DE_PreviousMonthRestTwoDaysCount = 0
DE_PreviousMonthRestThreeDaysCount = 0
End Sub
'==========================================================
' ÇÎÊÈÇÑ ãÓÊÞá ááãÍÑß ãä Ïæä ÇáßÊÇÈÉ Ýí LINE
'==========================================================
Public Sub TestDistributionEngine()
Dim Errors As Collection
Dim Passed As Collection
Dim Warnings As Collection
Dim ResultPassed As Boolean
Set Errors = New Collection
Set Passed = New Collection
Set Warnings = New Collection
ResultPassed = DistributionEngine_BuildPlan( _
Errors, Passed, Warnings)
DE_WriteDistributionTestReport _
ResultPassed, Errors, Warnings, Passed
MsgBox _
"Êã ÅäÔÇÁ ÊÞÑíÑ ÇÎÊÈÇÑ ÇáÊæÒíÚ Ýí ÔíÊ " & _
"DISTRIBUTION_REPORT.", _
IIf(ResultPassed, vbInformation, vbExclamation), _
"ÇÎÊÈÇÑ ãÍÑß ÇáÊæÒíÚ"
End Sub
'==========================================================
' ÅäÔÇÁ ÊÞÑíÑ ÇÎÊÈÇÑ ÇáãÍÑß ÏÇÎá ÔíÊ ãÓÊÞá.
'
' áÇ íßÊÈ åÐÇ ÇáÅÌÑÇÁ Ãí ÔíÁ Ýí LINE¡ æáÇ íÍÐÝ ÇáÔíʺ
' Èá íãÓÍ ãÍÊæì ÇáÊÞÑíÑ ÇáÓÇÈÞ Ëã íßÊÈ ÇáÊÞÑíÑ ÇáÌÏíÏ.
'==========================================================
Private Sub DE_WriteDistributionTestReport( _
ByVal ResultPassed As Boolean, _
ByVal ErrorResults As Collection, _
ByVal WarningResults As Collection, _
ByVal PassedResults As Collection)
Const REPORT_SHEET As String = _
"DISTRIBUTION_REPORT"
Dim ws As Worksheet
Dim NextRow As Long
Dim SequenceNumber As Long
Dim FinalRow As Long
Dim ReportRange As Range
Dim ReportWindow As Window
Dim PreviousScreenUpdating As Boolean
Dim ReportErrorNumber As Long
Dim ReportErrorDescription As String
PreviousScreenUpdating = Application.ScreenUpdating
On Error GoTo ReportError
Set ws = DE_GetOrCreateReportSheet(REPORT_SHEET)
Application.ScreenUpdating = False
ws.Visible = xlSheetVisible
ws.Cells.Clear
ws.DisplayRightToLeft = True
' ÚäæÇä ÇáÊÞÑíÑ.
With ws.Range("A1:D1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Bold = True
.Font.Size = 16
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(0, 78, 76)
End With
ws.Range("A1").Value = _
"ÊÞÑíÑ ÇÎÊÈÇÑ ãÍÑß ÊæÒíÚ ÇáÑÍáÇÊ"
ws.Rows(1).RowHeight = 28
ws.Range("A2").Value = "ÇáÔåÑ"
ws.Range("B2").Value = _
UCase$(MonthName(DR_ActiveMonth, True))
ws.Range("C2").Value = "ÇáÓäÉ"
ws.Range("D2").Value = DR_ActiveYear
ws.Range("A3").Value = "äÊíÌÉ ÇáÇÎÊÈÇÑ"
If ResultPassed Then
ws.Range("B3").Value = "äÌÍ ÇáÇÎÊÈÇÑ"
ws.Range("B3").Interior.Color = _
RGB(198, 239, 206)
ws.Range("B3").Font.Color = _
RGB(0, 97, 0)
Else
ws.Range("B3").Value = "áã ÊßÊãá ÎØÉ ÇáÊæÒíÚ"
ws.Range("B3").Interior.Color = _
RGB(255, 199, 206)
ws.Range("B3").Font.Color = _
RGB(156, 0, 6)
End If
ws.Range("C3").Value = "ÊÇÑíÎ ÇáÊÞÑíÑ"
ws.Range("D3").NumberFormat = "@"
ws.Range("D3").Value = _
"'" & Format$(Now, "dd/mm/yyyy hh:mm")
With ws.Range("A2:D3")
.Borders.LineStyle = xlContinuous
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
' ÑÄæÓ ÃÚãÏÉ ÇáäÊÇÆÌ.
ws.Range("A5").Value = "ÇáÊÓáÓá"
ws.Range("B5").Value = "ÇáÊÕäíÝ"
ws.Range("C5").Value = "ÇáÍÇáÉ"
ws.Range("D5").Value = "ÇáÊÝÇÕíá"
With ws.Range("A5:D5")
.Font.Bold = True
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(0, 78, 76)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
End With
NextRow = 6
SequenceNumber = 0
DE_WriteReportCollection _
ws, ErrorResults, "ÎØÃ", _
NextRow, SequenceNumber
DE_WriteReportCollection _
ws, WarningResults, "ÊäÈíå", _
NextRow, SequenceNumber
DE_WriteReportCollection _
ws, PassedResults, "Óáíã", _
NextRow, SequenceNumber
If SequenceNumber = 0 Then
SequenceNumber = 1
ws.Cells(NextRow, "A").Value = SequenceNumber
ws.Cells(NextRow, "B").Value = "ãÚáæãÉ"
ws.Cells(NextRow, "C").Value = "áÇ ÊæÌÏ äÊÇÆÌ"
ws.Cells(NextRow, "D").Value = _
"áã íõÑÌÚ ÇáãÍÑß Ãí äÊÇÆÌ áÚÑÖåÇ."
NextRow = NextRow + 1
End If
FinalRow = NextRow - 1
Set ReportRange = ws.Range( _
"A5:D" & CStr(FinalRow))
With ReportRange
.Borders.LineStyle = xlContinuous
.VerticalAlignment = xlTop
End With
ws.Range("A6:C" & CStr(FinalRow)).HorizontalAlignment = _
xlCenter
ws.Range("D6:D" & CStr(FinalRow)).HorizontalAlignment = _
xlRight
ws.Range("D6:D" & CStr(FinalRow)).WrapText = True
ws.Columns("A").ColumnWidth = 10
ws.Columns("B").ColumnWidth = 16
ws.Columns("C").ColumnWidth = 20
ws.Columns("D").ColumnWidth = 95
ws.Rows("2:3").AutoFit
ws.Rows("5:" & CStr(FinalRow)).AutoFit
If ws.AutoFilterMode Then ws.AutoFilterMode = False
ws.Range("A5:D" & CStr(FinalRow)).AutoFilter
' ÅÚÏÇÏ ÚÑÖ ÇáÊÞÑíÑ ÇÎÊíÇÑí æáÇ íæÞÝ ßÊÇÈÉ ÇáäÊÇÆÌ.
On Error Resume Next
ws.Parent.Activate
ws.Activate
Set ReportWindow = Application.ActiveWindow
If Not ReportWindow Is Nothing Then
ReportWindow.View = xlNormalView
ReportWindow.FreezePanes = False
ReportWindow.SplitRow = 0
ReportWindow.SplitColumn = 0
Err.Clear
ws.Range("A6").Select
If Err.Number = 0 Then
ReportWindow.SplitRow = 5
ReportWindow.FreezePanes = True
End If
End If
Err.Clear
On Error GoTo ReportError
Application.ScreenUpdating = PreviousScreenUpdating
Exit Sub
ReportError:
ReportErrorNumber = Err.Number
ReportErrorDescription = Err.Description
Application.ScreenUpdating = PreviousScreenUpdating
MsgBox "ÊÚÐÑ ÅÎÑÇÌ ÇáÊÞÑíÑ. ÑÞã ÇáÎØÃ: " & CStr(ReportErrorNumber) & _
vbCrLf & ReportErrorDescription, vbExclamation, "ÊÞÑíÑ ÇáÊæÒíÚ"
End Sub
'==========================================================
' ÅÑÌÇÚ ÔíÊ ÇáÊÞÑíÑ Ãæ ÅäÔÇÄå ÅÐÇ áã íßä ãæÌæÏðÇ.
'==========================================================
Private Function DE_GetOrCreateReportSheet( _
ByVal SheetName As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(SheetName)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add( _
After:=ThisWorkbook.Worksheets( _
ThisWorkbook.Worksheets.Count))
ws.NAME = SheetName
End If
Set DE_GetOrCreateReportSheet = ws
End Function
'==========================================================
' ßÊÇÈÉ ãÌãæÚÉ äÊÇÆÌ Ýí ÊÞÑíÑ ÇáÇÎÊÈÇÑ.
'==========================================================
Private Sub DE_WriteReportCollection( _
ByVal ws As Worksheet, _
ByVal Results As Collection, _
ByVal DefaultCategory As String, _
ByRef NextRow As Long, _
ByRef SequenceNumber As Long)
Dim Item As Variant
Dim ResultText As String
Dim CategoryText As String
Dim StatusText As String
If Results Is Nothing Then Exit Sub
For Each Item In Results
ResultText = CStr(Item)
CategoryText = DefaultCategory
StatusText = DefaultCategory
If DE_IsShortageDiagnostic(ResultText) Then
CategoryText = "ÊÔÎíÕ ÚÌÒ"
StatusText = "ÊÝÇÕíá ÇáãæÇäÚ"
ElseIf DefaultCategory = "ÎØÃ" _
And InStr(1, ResultText, _
"ÚÌÒ", vbTextCompare) > 0 Then
CategoryText = "ÚÌÒ"
StatusText = "ÛíÑ ãÛØì"
ElseIf DefaultCategory = "ÎØÃ" Then
StatusText = "íÍÊÇÌ ãÚÇáÌÉ"
ElseIf DefaultCategory = "ÊäÈíå" Then
StatusText = "ááãÑÇÌÚÉ"
ElseIf DefaultCategory = "Óáíã" Then
StatusText = "ãßÊãá"
End If
SequenceNumber = SequenceNumber + 1
ws.Cells(NextRow, "A").Value = SequenceNumber
ws.Cells(NextRow, "B").Value = CategoryText
ws.Cells(NextRow, "C").Value = StatusText
ws.Cells(NextRow, "D").Value = ResultText
DE_ApplyReportRowColor _
ws.Range("A" & CStr(NextRow) & _
":D" & CStr(NextRow)), _
CategoryText
NextRow = NextRow + 1
Next Item
End Sub
'==========================================================
' Êáæíä ÕÝ ÇáÊÞÑíÑ ÍÓÈ äæÚ ÇáäÊíÌÉ.
'==========================================================
Private Sub DE_ApplyReportRowColor( _
ByVal TargetRange As Range, _
ByVal CategoryText As String)
Select Case CategoryText
Case "ÎØÃ"
TargetRange.Interior.Color = _
RGB(255, 199, 206)
TargetRange.Font.Color = _
RGB(156, 0, 6)
Case "ÚÌÒ", "ÊÔÎíÕ ÚÌÒ"
TargetRange.Interior.Color = _
RGB(252, 229, 205)
TargetRange.Font.Color = _
RGB(156, 87, 0)
Case "ÊäÈíå"
TargetRange.Interior.Color = _
RGB(255, 242, 204)
TargetRange.Font.Color = _
RGB(127, 96, 0)
Case "Óáíã"
TargetRange.Interior.Color = _
RGB(198, 239, 206)
TargetRange.Font.Color = _
RGB(0, 97, 0)
Case Else
TargetRange.Interior.Color = _
RGB(217, 217, 217)
TargetRange.Font.Color = _
RGB(0, 0, 0)
End Select
End Sub
'==========================================================
' ÇáÊÍÞÞ ãä Ãä ÇáäÕ ÊÞÑíÑ ÊÔÎíÕ ÚÌÒ ÊÝÕíáí.
'==========================================================
Private Function DE_IsShortageDiagnostic( _
ByVal ResultText As String) As Boolean
DE_IsShortageDiagnostic = _
(Left$(Trim$(ResultText), _
Len("[ÊÔÎíÕ]")) = "[ÊÔÎíÕ]" _
Or Left$(Trim$(ResultText), Len("[ÃåáíÉ ÝÚáíÉ")) = "[ÃåáíÉ ÝÚáíÉ")
End Function
'==========================================================
' ÚÑÖ ÊÞÇÑíÑ ÊÔÎíÕ ÇáÚÌÒ Ýí ÑÓÇÆá ãäÝÕáÉ.
'==========================================================
Private Sub DE_ShowShortageDiagnostics( _
ByVal ErrorResults As Collection)
Dim Item As Variant
Dim DiagnosticNumber As Long
If ErrorResults Is Nothing Then Exit Sub
For Each Item In ErrorResults
If DE_IsShortageDiagnostic(CStr(Item)) Then
DiagnosticNumber = DiagnosticNumber + 1
DE_ShowLongDiagnostic _
CStr(Item), _
"ÊÝÇÕíá ÚÌÒ ÇáÊæÒíÚ " & _
CStr(DiagnosticNumber)
End If
Next Item
End Sub
'==========================================================
' ÊÞÓíã ÇáÊÞÑíÑ ÇáØæíá Åáì ÕÝÍÇÊ ãä Ïæä ÞØÚ ÇáÓØæÑ.
'==========================================================
Private Sub DE_ShowLongDiagnostic( _
ByVal DiagnosticText As String, _
ByVal WindowTitle As String)
Const MAX_PAGE_LENGTH As Long = 650
Dim Lines As Variant
Dim LineItem As Variant
Dim CurrentPage As String
Dim Pages As Collection
Dim PageNumber As Long
Dim CandidateText As String
Set Pages = New Collection
Lines = Split(DiagnosticText, vbCrLf)
For Each LineItem In Lines
If CurrentPage = vbNullString Then
CandidateText = CStr(LineItem)
Else
CandidateText = CurrentPage & _
vbCrLf & CStr(LineItem)
End If
If Len(CandidateText) > MAX_PAGE_LENGTH _
And CurrentPage <> vbNullString Then
Pages.Add CurrentPage
CurrentPage = CStr(LineItem)
Else
CurrentPage = CandidateText
End If
Next LineItem
If CurrentPage <> vbNullString Then
Pages.Add CurrentPage
End If
For PageNumber = 1 To Pages.Count
MsgBox _
CStr(Pages(PageNumber)), _
vbExclamation, _
WindowTitle & " - ÇáÕÝÍÉ " & _
CStr(PageNumber) & " ãä " & _
CStr(Pages.Count)
Next PageNumber
End Sub
'==========================================================
' ÊÌåíÒ ÍÇáÉ ßá ãæÙÝ æãÓÊåÏÝ ãÌãæÚÊå
'==========================================================
Private Function DE_GroupFlightTarget(ByVal GroupCode As String) As Long
Select Case UCase$(Trim$(GroupCode))
Case "SSS", "SST": DE_GroupFlightTarget = 7
Case "STS": DE_GroupFlightTarget = 8
Case "STT": DE_GroupFlightTarget = 10
End Select
End Function
Private Function DE_InitializeEmployeeStates( _
ByRef ErrorResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim EmployeeRecord As Object
Dim State As Object
Dim Targets As Object
Dim GroupCode As String
Dim BusyPeriods As Collection
Dim EmployeeAssignments As Collection
Dim EventDates As Object
Dim PreviousLastFlightDate As Date
Dim PreviousMonthEnd As Date
Dim NewMonthStart As Date
Dim PreviousMonthRestEnd As Date
Dim PreviousMonthRestDays As Long
Dim PreviousTripType As String
Set Targets = DE_ReadGroupTargets(ErrorResults)
If Targets Is Nothing Then Exit Function
For Each EmployeeKey In DR_Employees.Keys
Set EmployeeRecord = DR_Employees(EmployeeKey)
GroupCode = UCase$(CStr(EmployeeRecord("GroupCode")))
If Not Targets.Exists(GroupCode) Then
ErrorResults.Add _
"áÇ íæÌÏ ãÓÊåÏÝ ááãÌãæÚÉ " & GroupCode & _
" ÇáÎÇÕÉ ÈÇáãæÙÝ " & CStr(EmployeeKey) & "."
Exit Function
End If
Set State = DE_NewRecord()
State.Add "EmployeeNumber", CStr(EmployeeKey)
State.Add "EmployeeName", _
CStr(EmployeeRecord("EmployeeName"))
State.Add "GroupCode", GroupCode
State.Add "CarrierProfile", _
UCase$(CStr(EmployeeRecord("CarrierProfile")))
State.Add "InfoRow", CLng(EmployeeRecord("InfoRow"))
State.Add "LineRow", CLng(EmployeeRecord("LineRow"))
State.Add "IsOffice", CBool(EmployeeRecord("IsOffice"))
State.Add "IsHold", CBool(EmployeeRecord("IsHold"))
State.Add "IsStandby", _
DR_SBByEmployee.Exists(CStr(EmployeeKey))
State.Add "OriginalFlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "NormalFlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "FlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "OriginalLayoverTarget", _
CLng(Targets(GroupCode)("Layovers"))
State.Add "LayoverTarget", _
CLng(Targets(GroupCode)("Layovers"))
State.Add "LongLayoverTarget", 0&
State.Add "ShortLayoverTarget", 0&
State.Add "LongLayoverCount", 0&
State.Add "ShortLayoverCount", 0&
State.Add "EventDayCount", 0&
State.Add "LongestEventDays", 0&
State.Add "TargetAdjustmentReason", vbNullString
State.Add "IsNoFlightMonth", False
State.Add "SaudiaTarget", 0&
State.Add "SpecialCarrierTarget", 0&
State.Add "SpecialCarrierCode", vbNullString
State.Add "SaudiaCount", 0&
State.Add "SpecialCarrierCount", 0&
State.Add "FlightCount", 0&
State.Add "LayoverCount", 0&
State.Add "CarryoverTarget", _
DE_EmployeeCarryoverCount(CStr(EmployeeKey))
State.Add "CarryoverAssigned", 0&
State.Add "CarryoverLayoverCount", 0&
State.Add "CarryoverLongLayoverCount", 0&
State.Add "CarryoverShortLayoverCount", 0&
State.Add "CarryoverSaudiaTarget", _
DE_EmployeeCarryoverCarrierCount( _
CStr(EmployeeKey), "SAUDIA")
State.Add "CarryoverSpecialTarget", _
DE_EmployeeCarryoverSpecialCount( _
CStr(EmployeeKey))
State.Add "LeaderCount", 0&
State.Add "ReserveCount", 0&
State.Add "HasPreviousMonthEndRest", False
' ÚÏÏ ÇáÑÍáÇÊ ÇáÊí ÃÖíÝÊ ÝæÞ ãÓÊåÏÝ ÇáãÌãæÚÉ áãÚÇáÌÉ ÇáÚÌÒ
State.Add "ExtraFlightCount", 0&
Set BusyPeriods = New Collection
Set EmployeeAssignments = New Collection
Set EventDates = CreateObject("Scripting.Dictionary")
EventDates.CompareMode = vbTextCompare
State.Add "BusyPeriods", BusyPeriods
State.Add "Assignments", EmployeeAssignments
State.Add "EventDates", EventDates
' ÅÐÇ ßÇäÊ ÂÎÑ ÑÍáÉ ááãæÙÝ Ýí ÂÎÑ íæã ãä ÇáÔåÑ ÇáÓÇÈÞ¡
' ÊõÍÌÒ ÑÇÍÉ ÈÏÇíÉ ÇáÔåÑ ÍÓÈ ÊÕäíÝ ÇáÑÍáÉ ÇáÓÇÈÞÉ:
' LAY = ËáÇËÉ ÃíÇã¡ LNG Ãæ MED = íæãÇä¡ SHT = íæã æÇÍÏ.
' æÊÓÊãÑ ÈÞíÉ ÔÑæØ ÇáÑÇÍÉ æÇáÊÚÇÑÖ Ïæä Ãí ÊÛííÑ.
If EmployeeRecord.Exists("HasPreviousLastFlight") Then
If CBool(EmployeeRecord("HasPreviousLastFlight")) Then
PreviousLastFlightDate = CDate(CDbl( _
EmployeeRecord("PreviousLastFlightDate")))
PreviousMonthEnd = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 0)
If Int(CDbl(PreviousLastFlightDate)) = _
Int(CDbl(PreviousMonthEnd)) Then
NewMonthStart = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 1)
PreviousMonthRestDays = _
DE_GetPreviousMonthRestDays( _
EmployeeRecord, PreviousTripType)
PreviousMonthRestEnd = DateAdd( _
"d", PreviousMonthRestDays, NewMonthStart)
DE_AddBusyPeriod _
State, _
NewMonthStart, _
PreviousMonthRestEnd, _
DE_TYPE_PREVIOUS_MONTH_REST, _
False, _
"ÑÇÍÉ ÈÏÇíÉ ÇáÔåÑ áãÏÉ " & _
DE_ArabicDayPhrase(PreviousMonthRestDays) & _
" ÈÓÈÈ ÑÍáÉ " & PreviousTripType & _
" Ýí ÂÎÑ íæã ãä ÇáÔåÑ ÇáÓÇÈÞ"
State("HasPreviousMonthEndRest") = True
DE_PreviousMonthRestCount = _
DE_PreviousMonthRestCount + 1
Select Case PreviousMonthRestDays
Case 1
DE_PreviousMonthRestOneDayCount = _
DE_PreviousMonthRestOneDayCount + 1
Case 2
DE_PreviousMonthRestTwoDaysCount = _
DE_PreviousMonthRestTwoDaysCount + 1
Case 3
DE_PreviousMonthRestThreeDaysCount = _
DE_PreviousMonthRestThreeDaysCount + 1
End Select
End If
End If
End If
DE_EmployeeStates.Add CStr(EmployeeKey), State
Next EmployeeKey
DE_InitializeEmployeeStates = True
End Function
'==========================================================
' ÍÓÇÈ ÚÏÏ ÇáãØÇáÈÇÊ ÇáãÓÌáÉ áãæÙÝ
'==========================================================
Private Function DE_EmployeeCarryoverCount( _
ByVal EmployeeNumber As String) As Long
Dim CarryoverRecord As Object
For Each CarryoverRecord In DR_CarryoverFlights
If StrComp(CStr(CarryoverRecord("EmployeeNumber")), _
EmployeeNumber, vbTextCompare) = 0 Then
DE_EmployeeCarryoverCount = _
DE_EmployeeCarryoverCount + 1
End If
Next CarryoverRecord
End Function
'==========================================================
' ÍÓÇÈ ãØÇáÈÇÊ ãæÙÝ áäÇÞá ãÍÏÏ
'==========================================================
Private Function DE_EmployeeCarryoverCarrierCount( _
ByVal EmployeeNumber As String, _
ByVal CarrierCode As String) As Long
Dim CarryoverRecord As Object
For Each CarryoverRecord In DR_CarryoverFlights
If StrComp(CStr(CarryoverRecord("EmployeeNumber")), _
EmployeeNumber, vbTextCompare) = 0 _
And StrComp(CStr(CarryoverRecord("CarrierCode")), _
CarrierCode, vbTextCompare) = 0 Then
DE_EmployeeCarryoverCarrierCount = _
DE_EmployeeCarryoverCarrierCount + 1
End If
Next CarryoverRecord
End Function
'==========================================================
' ÍÓÇÈ ãØÇáÈÇÊ ÇáãæÙÝ ááäÇÞá ÇáãÊÎÕÕ Ýí ãáÝå
'==========================================================
Private Function DE_EmployeeCarryoverSpecialCount( _
ByVal EmployeeNumber As String) As Long
Dim EmployeeRecord As Object
Dim SpecialCarrier As String
If Not DR_Employees.Exists(EmployeeNumber) Then Exit Function
Set EmployeeRecord = DR_Employees(EmployeeNumber)
Select Case UCase$(CStr(EmployeeRecord("CarrierProfile")))
Case "SAUDIA_NAS": SpecialCarrier = "NAS"
Case "SAUDIA_ADEAL": SpecialCarrier = "ADEAL"
Case Else: Exit Function
End Select
DE_EmployeeCarryoverSpecialCount = _
DE_EmployeeCarryoverCarrierCount( _
EmployeeNumber, SpecialCarrier)
End Function
'==========================================================
' ÞÑÇÁÉ ãÓÊåÏÝ ÇáÑÍáÇÊ æÇáãÈíÊ ãä INFO!K:M
'==========================================================
Private Function DE_ReadGroupTargets( _
ByRef ErrorResults As Collection) As Object
Dim ws As Worksheet
Dim Targets As Object
Dim LastRow As Long
Dim CurrentRow As Long
Dim GroupCode As String
Dim FlightsText As String
Dim LayoversText As String
Dim Target As Object
Set ws = ThisWorkbook.Worksheets(DE_INFO)
Set Targets = CreateObject("Scripting.Dictionary")
Targets.CompareMode = vbTextCompare
LastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row
For CurrentRow = 1 To LastRow
GroupCode = UCase$(DE_Text( _
ws.Cells(CurrentRow, "K").Value2))
If DE_IsGroupCode(GroupCode) Then
FlightsText = DE_Text( _
ws.Cells(CurrentRow, "L").Value2)
LayoversText = DE_Text( _
ws.Cells(CurrentRow, "M").Value2)
If Not DE_IsDigits(FlightsText) _
Or Not DE_IsDigits(LayoversText) Then
ErrorResults.Add _
"ãÓÊåÏÝ ÇáãÌãæÚÉ " & GroupCode & _
" ÛíÑ ÕÍíÍ Ýí INFO!K:M."
Exit Function
End If
Set Target = DE_NewRecord()
Target.Add "Flights", CLng(FlightsText)
Target.Add "Layovers", CLng(LayoversText)
If Targets.Exists(GroupCode) Then
Targets.Remove GroupCode
End If
Targets.Add GroupCode, Target
End If
Next CurrentRow
If Targets.Count <> 4 Then
ErrorResults.Add _
"ÊÚÐÑ ÞÑÇÁÉ ãÓÊåÏÝÇÊ ÇáãÌãæÚÇÊ ÇáÃÑÈÚ ãä INFO!K:M."
Exit Function
End If
Set DE_ReadGroupTargets = Targets
End Function
'==========================================================
' ÊÍáíá ßá ãÑÉ ÊÔÛíá æÅÖÇÝÉ ÊÝÇÕíáåÇ ÇááÇÒãÉ ááÊæÒíÚ
'==========================================================
Private Function DE_InitializeRunPlans( _
ByRef ErrorResults As Collection, _
ByRef PassedResults As Collection) As Boolean
Dim ws As Worksheet
Dim SourceRun As Object
Dim RunPlan As Object
Dim SortedRuns() As Object
Dim RunCount As Long
Dim Index As Long
Dim SwapIndex As Long
Dim TempRun As Object
Set ws = ThisWorkbook.Worksheets(DE_PAIRING)
RunCount = DR_PairingRuns.Count
If RunCount = 0 Then
ErrorResults.Add "áÇ ÊæÌÏ ãÑÇÊ ÊÔÛíá ÌÇåÒÉ ááÊæÒíÚ."
Exit Function
End If
ReDim SortedRuns(1 To RunCount)
For Index = 1 To RunCount
Set SourceRun = DR_PairingRuns(Index)
Set RunPlan = DE_BuildRunPlan( _
ws, SourceRun, ErrorResults)
If RunPlan Is Nothing Then Exit Function
Set SortedRuns(Index) = RunPlan
PassedResults.Add "[ÊÕäíÝ ÇáÈíÑäÞ] " & _
CStr(RunPlan("PairingNumber")) & " ÈÊÇÑíÎ " & _
Format$(CDate(RunPlan("OperatingDate")), "dd/mm/yyyy") & _
": " & CStr(RunPlan("LayoverEvidence"))
Next Index
' ÊÑÊíÈ Òãäí ËÇÈʺ æÚäÏ ÊÓÇæí ÇáÊÇÑíÎ íÑÊÈ ÈÑÞã ÇáÈíÑäÞ.
For Index = 1 To RunCount - 1
For SwapIndex = Index + 1 To RunCount
If DE_RunComesAfter( _
SortedRuns(Index), SortedRuns(SwapIndex)) Then
Set TempRun = SortedRuns(Index)
Set SortedRuns(Index) = SortedRuns(SwapIndex)
Set SortedRuns(SwapIndex) = TempRun
End If
Next SwapIndex
Next Index
For Index = 1 To RunCount
SortedRuns(Index)("RunIndex") = Index
DE_RunPlans.Add SortedRuns(Index)
Next Index
DE_InitializeRunPlans = True
End Function
Private Function DE_BuildRunPlan( _
ByVal ws As Worksheet, _
ByVal SourceRun As Object, _
ByRef ErrorResults As Collection) As Object
Dim StartRow As Long
Dim CreditRow As Long
Dim StartColumn As Long
Dim EndColumn As Long
Dim DetailRow As Long
Dim FirstFlightRow As Long
Dim LastFlightRow As Long
Dim LayoverRow As Long
Dim HotelName As String
Dim CandidateHotel As String
Dim HotelColumn As Long
Dim DurationText As String
Dim FlightDayCode As String
Dim FirstDayCode As String
Dim LastDayCode As String
Dim StationCode As String
Dim LayoverStation As String
Dim LayoverClass As String
Dim LayoverHours As Double
Dim TripType As String
Dim RequiredCrew As Long
Dim StartClock As Double
Dim EndClock As Double
Dim DayOffset As Long
Dim OperatingDate As Date
Dim StartDateTime As Date
Dim EndDateTime As Date
Dim RunPlan As Object
Dim AssignedEmployees As Collection
StartRow = CLng(SourceRun("StartRow"))
CreditRow = CLng(SourceRun("CreditRow"))
StartColumn = CLng(SourceRun("StartColumn"))
EndColumn = CLng(SourceRun("EndColumn"))
FirstDayCode = UCase$(CStr(SourceRun("DayCode")))
OperatingDate = CDate(CDbl(SourceRun("OperatingDate")))
For DetailRow = StartRow + 2 To CreditRow - 1
FlightDayCode = UCase$(DE_Text( _
ws.Cells(DetailRow, StartColumn).Value2))
If DE_IsDayCode(FlightDayCode) Then
If FirstFlightRow = 0 Then FirstFlightRow = DetailRow
LastFlightRow = DetailRow
ElseIf DE_RowHasData( _
ws, DetailRow, StartColumn, EndColumn) Then
' ÇÓã ÇáÝäÏÞ íÞÚ ÞÈá ÚãæÏí ãÍØÉ ÇáãÈíÊ æãÏÊå.
' ÊÌÇåá ÇáÕÝæÝ ÇáÝÇÑÛÉ æÇáãáÇÍÙÇÊ ÇáÊí áÇ ÊÍãá ÈíÇäÇÊ ãÈíÊ.
CandidateHotel = vbNullString
For HotelColumn = StartColumn To StartColumn + 7
If Not IsError(ws.Cells(DetailRow, HotelColumn).Value2) Then
DurationText = DE_Text( _
ws.Cells(DetailRow, HotelColumn).Value2)
If DurationText <> vbNullString Then
If Not IsNumeric(DurationText) Then
If CandidateHotel <> vbNullString Then _
CandidateHotel = CandidateHotel & " "
CandidateHotel = CandidateHotel & DurationText
End If
End If
End If
Next HotelColumn
DurationText = DE_Text( _
ws.Cells(DetailRow, StartColumn + 9).Value2)
' áÇ íßÝí ÇÎÊáÇÝ íæã ÇáÚæÏÉ Ãæ ÇÓã ÇáãÍØÉ áÅËÈÇÊ ÇáãÈíÊ.
If CandidateHotel <> vbNullString Or _
DurationText <> vbNullString Then
If CandidateHotel = vbNullString Then
ErrorResults.Add "ãÏÉ ãÈíÊ Ïæä ÇÓã ÝäÏÞ Ýí ÇáÈíÑäÞ " & _
CStr(SourceRun("PairingNumber")) & _
"¡ ÕÝ " & CStr(DetailRow) & ". ÑÇÌÚ ÈíÇäÇÊ ÇáÈíÑäÞ."
Exit Function
End If
If LayoverRow > 0 Then
ErrorResults.Add "íæÌÏ ÃßËÑ ãä ÓØÑ ãÈíÊ Ýí ÇáÈíÑäÞ " & _
CStr(SourceRun("PairingNumber")) & _
". íáÒã ÏÚã ÇáãÈíÊ ÇáãÊÚÏÏ ÞÈá ÊæÒíÚå."
Exit Function
End If
LayoverRow = DetailRow
HotelName = CandidateHotel
End If
End If
Next DetailRow
If FirstFlightRow = 0 Or LastFlightRow = 0 Then
ErrorResults.Add _
"ÊÚÐÑ ÞÑÇÁÉ ÞØÇÚÇÊ ÇáÈíÑäÞ " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
StationCode = UCase$(DE_Text( _
ws.Cells(FirstFlightRow, StartColumn + 6).Value2))
If StationCode = "JED" Then
StationCode = UCase$(DE_Text( _
ws.Cells(LastFlightRow, StartColumn + 3).Value2))
End If
If LayoverRow > 0 Then
LayoverStation = UCase$(DE_Text( _
ws.Cells(LayoverRow, StartColumn + 8).Value2))
If LayoverStation <> vbNullString Then
StationCode = LayoverStation
End If
If Not DE_ReadDurationHours( _
ws.Cells(LayoverRow, StartColumn + 9), _
LayoverHours) Then
ErrorResults.Add _
"ÊÚÐÑ ÞÑÇÁÉ ÓÇÚÇÊ ÇáãÈíÊ ááÈíÑäÞ " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If LayoverHours <= 0# Or LayoverStation = vbNullString Then
ErrorResults.Add _
"ÈíÇäÇÊ ÇáãÈíÊ äÇÞÕÉ Ãæ ãÏÊå ÛíÑ ãæÌÈÉ ááÈíÑäÞ " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If LayoverHours >= 50# Then
LayoverClass = "LONG"
Else
LayoverClass = "SHORT"
End If
End If
If Not DR_CrewRequirements.Exists(StationCode) Then
ErrorResults.Add _
"ÇáãÍØÉ " & StationCode & _
" ááÈíÑäÞ " & CStr(SourceRun("PairingNumber")) & _
" ÛíÑ ãæÌæÏÉ Öãä ãÊØáÈÇÊ INFO!G:I."
Exit Function
End If
RequiredCrew = CLng( _
DR_CrewRequirements(StationCode)("CrewCount"))
TripType = CStr( _
DR_CrewRequirements(StationCode)("TripType"))
' ÚÏÏ ÃÝÑÇÏ ÇáãÈíÊ ãÓÊÞá Úä ÚÏÏ ÃÝÑÇÏ ÇáÑÇæäÏÊÑÈ ááãÍØÉ.
If LayoverRow > 0 Then RequiredCrew = 2
' ÇÓÊËäÇÁ ÚÏÏ ÇáØÇÞã ÇÎÊíÇÑí æãÞíÏ ÈÇáÔåÑ æÇáÓäÉ æÇáÈíÑäÞ.
If Not DE_ResolveCrewOverride( _
CStr(SourceRun("PairingNumber")), OperatingDate, _
RequiredCrew, ErrorResults) Then Exit Function
If Not DE_ReadClock( _
ws.Cells(FirstFlightRow, StartColumn + 4), StartClock) Then
ErrorResults.Add _
"ÊÚÐÑ ÞÑÇÁÉ æÞÊ ÈÏÇíÉ ÇáÈíÑäÞ " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If Not DE_ReadClock( _
ws.Cells(LastFlightRow, StartColumn + 7), EndClock) Then
ErrorResults.Add _
"ÊÚÐÑ ÞÑÇÁÉ æÞÊ äåÇíÉ ÇáÈíÑäÞ " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
LastDayCode = UCase$(DE_Text( _
ws.Cells(LastFlightRow, StartColumn).Value2))
DayOffset = DE_DayOffset(FirstDayCode, LastDayCode)
If DayOffset = 0 Then
If EndClock < DE_CellClockValue( _
ws.Cells(LastFlightRow, StartColumn + 4)) Then
DayOffset = 1
End If
End If
StartDateTime = OperatingDate + StartClock
EndDateTime = OperatingDate + DayOffset + EndClock
If EndDateTime <= StartDateTime Then
EndDateTime = EndDateTime + 1
End If
Set RunPlan = DE_NewRecord()
RunPlan.Add "RunIndex", 0&
RunPlan.Add "PairingNumber", _
CStr(SourceRun("PairingNumber"))
' ÑÍáÇÊ ÍáÈ ALP ÊõÛØì ÍÕÑíðÇ ÈæÇÓØÉ ÇáãÄåáíä áÑÍáÇÊ äÇÓ¡
' ÍÊì áæ ßÇäÊ æÇÞÚÉ ÞÈá ÚäæÇä FLY NAS Ýí ÔíÊ PAIRING.
If StationCode = "ALP" Then
RunPlan.Add "CarrierCode", "NAS"
Else
RunPlan.Add "CarrierCode", _
UCase$(CStr(SourceRun("CarrierCode")))
End If
RunPlan.Add "OperatingDate", CDbl(OperatingDate)
RunPlan.Add "StartDateTime", CDbl(StartDateTime)
RunPlan.Add "EndDateTime", CDbl(EndDateTime)
RunPlan.Add "ReturnDayOffset", DayOffset
RunPlan.Add "StationCode", StationCode
RunPlan.Add "TripType", TripType
RunPlan.Add "IsLayover", (LayoverRow > 0)
RunPlan.Add "HotelName", HotelName
If LayoverRow > 0 Then
RunPlan.Add "LayoverEvidence", _
"ãÈíʺ ÇáÝäÏÞ: " & HotelName & _
"º ÇáãÏÉ ÈÇáÓÇÚÇÊ: " & Format$(LayoverHours, "0.00") & _
"º ÕÝ ÇáãÕÏÑ: " & CStr(LayoverRow)
Else
RunPlan.Add "LayoverEvidence", _
"ÑÇæäÏÊÑȺ áÇ íæÌÏ ÓØÑ ÝäÏÞ æãÏÉ ãÈíÊ Ýí ÇáÈíÑäÞ."
End If
RunPlan.Add "LayoverHours", LayoverHours
RunPlan.Add "LayoverClass", LayoverClass
RunPlan.Add "RequiredCrew", RequiredCrew
RunPlan.Add "StartRow", StartRow
RunPlan.Add "CreditRow", CreditRow
RunPlan.Add "StartColumn", StartColumn
Set AssignedEmployees = New Collection
RunPlan.Add "AssignedEmployees", AssignedEmployees
RunPlan.Add "LeaderEmployee", vbNullString
RunPlan.Add "OfficeCount", 0&
Set DE_BuildRunPlan = RunPlan
End Function
'==========================================================
' ÊËÈíÊ ÇáÇÑÊÈÇØÇÊ ÈÇÚÊÈÇÑåÇ ÝÊÑÇÊ ãäÚ
'==========================================================
Private Function DE_RegisterEvents( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim EventRecord As Object
Dim State As Object
Dim EmployeeNumber As String
Dim StartDate As Date
Dim EndDate As Date
Dim MonthStart As Date
Dim MonthEnd As Date
Dim ActiveStart As Date
Dim ActiveEnd As Date
Dim DateCursor As Date
Dim DateKey As String
Dim EventDates As Object
MonthStart = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 1)
MonthEnd = DateSerial( _
DR_ActiveYear, DR_ActiveMonth + 1, 0)
For Each EventRecord In DR_Events
EmployeeNumber = CStr(EventRecord("EmployeeNumber"))
If Not DE_EmployeeStates.Exists(EmployeeNumber) Then
ErrorResults.Add _
"ãæÙÝ ÇáÇÑÊÈÇØ ÑÞã " & EmployeeNumber & _
" ÛíÑ ãæÌæÏ Öãä ÍÇáÇÊ ÇáÊæÒíÚ."
Exit Function
End If
Set State = DE_EmployeeStates(EmployeeNumber)
StartDate = CDate(CDbl(EventRecord("StartDate")))
EndDate = CDate(CDbl(EventRecord("EndDate"))) + 1
DE_AddBusyPeriod State, StartDate, EndDate, _
DE_TYPE_EVENT, False, _
CStr(EventRecord("EventName"))
ActiveStart = StartDate
If ActiveStart < MonthStart Then ActiveStart = MonthStart
ActiveEnd = EndDate - 1
If ActiveEnd > MonthEnd Then ActiveEnd = MonthEnd
If ActiveStart <= ActiveEnd Then
Set EventDates = State("EventDates")
If CLng(CDbl(ActiveEnd) - _
CDbl(ActiveStart) + 1) > _
CLng(State("LongestEventDays")) Then
State("LongestEventDays") = _
CLng(CDbl(ActiveEnd) - _
CDbl(ActiveStart) + 1)
End If
For DateCursor = ActiveStart To ActiveEnd
DateKey = CStr(CLng(CDbl(DateCursor)))
If Not EventDates.Exists(DateKey) Then
EventDates.Add DateKey, True
End If
Next DateCursor
End If
Next EventRecord
If Not DE_ApplyEventTargetAdjustments( _
ErrorResults, WarningResults) Then Exit Function
DE_RegisterEvents = True
End Function
'==========================================================
' ÊÍÏíÏ ÑÇÍÉ ÈÏÇíÉ ÇáÔåÑ ãä ÊÕäíÝ ÂÎÑ ÑÍáÉ Ýí ÇáÔåÑ ÇáÓÇÈÞ
'==========================================================
Private Function DE_GetPreviousMonthRestDays( _
ByVal EmployeeRecord As Object, _
ByRef PreviousTripType As String) As Long
Dim StationCode As String
Dim SeparatorPosition As Long
Dim Requirement As Object
PreviousTripType = vbNullString
If EmployeeRecord.Exists("PreviousLastStation") Then
StationCode = UCase$(Trim$(CStr( _
EmployeeRecord("PreviousLastStation"))))
End If
' ÞÏ ÊõÍÝÙ ÇáÑÍáÉ ÇáÓÇÈÞÉ ãËá DAC-MED Ãæ DAC MEDº
' ÇáÊÕäíÝ íÚÊãÏ Úáì ãÍØÉ ÇáÐåÇÈ ÇáÃÓÇÓíÉ.
StationCode = Replace$(StationCode, "/", "-")
StationCode = Replace$(StationCode, " ", "-")
Do While InStr(1, StationCode, "--", vbBinaryCompare) > 0
StationCode = Replace$(StationCode, "--", "-")
Loop
SeparatorPosition = InStr(1, StationCode, "-", vbTextCompare)
If SeparatorPosition > 1 Then
StationCode = Left$(StationCode, SeparatorPosition - 1)
ElseIf Len(StationCode) = 6 Then
StationCode = Left$(StationCode, 3)
End If
If Not DR_CrewRequirements Is Nothing Then
If DR_CrewRequirements.Exists(StationCode) Then
Set Requirement = DR_CrewRequirements(StationCode)
PreviousTripType = UCase$(Trim$(CStr( _
Requirement("TripType"))))
End If
End If
Select Case PreviousTripType
Case "LAY"
DE_GetPreviousMonthRestDays = 3
Case "LNG", "MED"
DE_GetPreviousMonthRestDays = 2
Case "SHT"
DE_GetPreviousMonthRestDays = 1
Case Else
' ÅÐÇ ÊÚÐÑ ÇáÊÚÑÝ Úáì ÇáÊÕäíÝ¡ äÓÊÎÏã íæãíä ßÍá Âãä
' æäÓÌá ÊäÈíåðÇ æÇÖÍðÇ ÈÏá ÅíÞÇÝ ÎØÉ ÇáÊæÒíÚ ÈÇáßÇãá.
DE_GetPreviousMonthRestDays = 2
PreviousTripType = "ÛíÑ ãÕäÝÉ"
If Not DE_Warnings Is Nothing Then
DE_Warnings.Add _
"ÊÚÐÑ ÊÍÏíÏ ÊÕäíÝ ÂÎÑ ÑÍáÉ ááãæÙÝ " & _
CStr(EmployeeRecord("EmployeeNumber")) & _
" ãä ÇáãÍØÉ [" & StationCode & _
"]. Êã ÇÚÊãÇÏ íæãíä ÑÇÍÉ ÈÕæÑÉ ÇÍÊíÇØíÉ."
End If
End Select
End Function
'==========================================================
' ÕíÇÛÉ ßáãÉ íæã Ýí æÕÝ ÝÊÑÉ ÇáÑÇÍÉ
'==========================================================
Private Function DE_ArabicDayPhrase( _
ByVal DayCount As Long) As String
Select Case DayCount
Case 1
DE_ArabicDayPhrase = "íæã æÇÍÏ"
Case 2
DE_ArabicDayPhrase = "íæãíä"
Case Else
DE_ArabicDayPhrase = CStr(DayCount) & " ÃíÇã"
End Select
End Function
'==========================================================
' ÊÚÏíá ãÓÊåÏÝ ÇáãæÙÝ ÍÓÈ ãÌãæÚ ÃíÇã ÇÑÊÈÇØÇÊå Ýí ÇáÔåÑ
'
' ÇáãÏÏ ÇáãÚÊãÏÉ:
' 10 ÃíÇã: ÎÕã ÑÍáÊíä.
' 15 íæãðÇ: äÕÝ ÇáãÓÊåÏÝ ãÚ ÇáÊÞÑíÈ ááÃÚáì.
' 30 íæãðÇ: ãäÚ ßÇãá ãä ÇáÑÍáÇÊ æÇáãÈíÊ æÇáÇÍÊíÇØ.
'==========================================================
Private Function DE_ApplyEventTargetAdjustments( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim State As Object
Dim EventDayCount As Long
Dim OriginalFlights As Long
Dim AdjustedFlights As Long
Dim OriginalLayovers As Long
Dim AdjustedLayovers As Long
Dim DaysInMonth As Long
Dim CarryoverTarget As Long
DaysInMonth = GregDaysInMonth( _
DR_ActiveYear, DR_ActiveMonth)
For Each EmployeeKey In DE_EmployeeStates.Keys
Set State = DE_EmployeeStates(EmployeeKey)
EventDayCount = CLng(State("LongestEventDays"))
OriginalFlights = CLng(State("OriginalFlightTarget"))
OriginalLayovers = CLng(State("OriginalLayoverTarget"))
AdjustedFlights = OriginalFlights
CarryoverTarget = CLng(State("CarryoverTarget"))
State("EventDayCount") = State("EventDates").Count
State("TargetAdjustmentReason") = vbNullString
State("IsNoFlightMonth") = False
Select Case EventDayCount
Case 0 To 9
' íãäÚ ÇáÇÑÊÈÇØ ÃíÇãå ÝÞØ¡ æáÇ íÎÝÖ ÇáãÓÊåÏÝ.
Case 10
AdjustedFlights = OriginalFlights - 2
If AdjustedFlights < 0 Then AdjustedFlights = 0
State("TargetAdjustmentReason") = _
"ÇÑÊÈÇØ 10 ÃíÇã: ÎÕã ÑÍáÊíä"
Case 15
AdjustedFlights = (OriginalFlights + 1) \ 2
State("TargetAdjustmentReason") = _
"ÇÑÊÈÇØ 15 íæãðÇ: äÕÝ ÇáãÓÊåÏÝ"
Case Is >= 30
AdjustedFlights = 0
State("IsNoFlightMonth") = True
State("TargetAdjustmentReason") = _
"ÇÑÊÈÇØ 30 íæãðÇ: ãäÚ ÔåÑí ßÇãá"
Case Else
WarningResults.Add _
"ãÏÉ ÇÑÊÈÇØ ÇáãæÙÝ " & _
CStr(State("EmployeeNumber")) & _
" ÏÇÎá ÇáÔåÑ åí " & _
CStr(EventDayCount) & _
" íæãðÇ¡ æåí áíÓÊ ãä ÇáãÏÏ ÇáãÚÊãÏÉ " & _
"10 Ãæ 15 Ãæ 30 íæãðǺ ãõäÚÊ ÃíÇã " & _
"ÇáÇÑÊÈÇØ Ïæä ÊÎÝíÖ ÇáãÓÊåÏÝ."
End Select
If OriginalFlights > 0 _
And OriginalLayovers > 0 _
And AdjustedFlights > 0 Then
AdjustedLayovers = _
((OriginalLayovers * AdjustedFlights) + _
OriginalFlights - 1) \ OriginalFlights
Else
AdjustedLayovers = 0
End If
If AdjustedLayovers > AdjustedFlights Then
AdjustedLayovers = AdjustedFlights
End If
' ÇáÅÏÇÑí æÇáãæÞæÝ æãæÙÝ ÇáÇÓÊÇäÏÈÇí áÇ íÏÎáæä Ýí
' ÇáÊæÒíÚ ÇáÂáí æáÇ ÇáÇÍÊíÇØ. ÑÍáÇÊ ÇáÅÏÇÑí ÊõËÈÊ ÝÞØ
' ãä OFFICE_DATA¡ æãæÙÝ SB íõÓÌá áå ÊäÇæÈå ÇáÔåÑí ÝÞØ.
If CBool(State("IsOffice")) _
Or CBool(State("IsHold")) _
Or CBool(State("IsStandby")) Then
AdjustedFlights = 0
AdjustedLayovers = 0
CarryoverTarget = 0
End If
State("NormalFlightTarget") = AdjustedFlights
State("FlightTarget") = _
AdjustedFlights + CarryoverTarget
State("LayoverTarget") = AdjustedLayovers
If AdjustedLayovers > 0 Then
State("LongLayoverTarget") = 1
State("ShortLayoverTarget") = _
AdjustedLayovers - 1
Else
State("LongLayoverTarget") = 0
State("ShortLayoverTarget") = 0
End If
DE_SetEmployeeCarrierTargets State
Next EmployeeKey
DE_ApplyEventTargetAdjustments = True
End Function
'==========================================================
' ÊÞÓíã ãÓÊåÏÝ ÇáãæÙÝ Èíä ÇáÓÚæÏíÉ æÇáäÇÞá ÇáãÊÎÕÕ
'==========================================================
Private Sub DE_SetEmployeeCarrierTargets( _
ByVal State As Object)
Dim TotalTarget As Long
Dim SaudiaTarget As Long
Dim SpecialTarget As Long
Dim SpecialCarrier As String
Dim SaudiaDemand As Long
Dim SpecialDemand As Long
' íÞÓã ÇáãÓÊåÏÝ ÇáÚÇÏí ÃæáðÇ¡ Ëã ÊÖÇÝ ãØÇáÈÇÊ ÇáÔåÑ
' ÇáÓÇÈÞ Åáì äÇÞáåÇ ÇáãÍÏÏ Ïæä ÊÛííÑ ÊæÇÒä ÇáÑÍáÇÊ ÇáÚÇÏíÉ.
TotalTarget = CLng(State("NormalFlightTarget"))
Select Case UCase$(CStr(State("CarrierProfile")))
Case "SAUDIA_NAS"
SpecialCarrier = "NAS"
Case "SAUDIA_ADEAL"
SpecialCarrier = "ADEAL"
Case Else
SpecialCarrier = vbNullString
End Select
If SpecialCarrier = vbNullString Then
SaudiaTarget = TotalTarget
SpecialTarget = 0
Else
SaudiaTarget = TotalTarget \ 2
SpecialTarget = TotalTarget \ 2
If TotalTarget Mod 2 <> 0 Then
SaudiaDemand = DE_CarrierRunCount("SAUDIA")
SpecialDemand = DE_CarrierRunCount(SpecialCarrier)
If SaudiaDemand > SpecialDemand Then
SaudiaTarget = SaudiaTarget + 1
Else
SpecialTarget = SpecialTarget + 1
End If
End If
End If
State("SaudiaTarget") = SaudiaTarget
State("SpecialCarrierTarget") = SpecialTarget
State("SpecialCarrierCode") = SpecialCarrier
State("SaudiaTarget") = _
CLng(State("SaudiaTarget")) + _
CLng(State("CarryoverSaudiaTarget"))
State("SpecialCarrierTarget") = _
CLng(State("SpecialCarrierTarget")) + _
CLng(State("CarryoverSpecialTarget"))
End Sub
Private Function DE_CarrierRunCount( _
ByVal CarrierCode As String) As Long
Dim RunPlan As Object
For Each RunPlan In DE_RunPlans
If StrComp(CStr(RunPlan("CarrierCode")), _
CarrierCode, vbTextCompare) = 0 Then
DE_CarrierRunCount = _
DE_CarrierRunCount + 1
End If
Next RunPlan
End Function
'==========================================================
' ÅäÔÇÁ ÊäÇæÈ SB-1 / SB-2 / SB-3 ØæÇá ÇáÔåÑ
'==========================================================
Private Function DE_RegisterStandby( _
ByRef ErrorResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim State As Object
Dim SBGroup As String
Dim GroupNumber As Long
Dim DayNumber As Long
Dim DaysInMonth As Long
Dim DutyDate As Date
DaysInMonth = GregDaysInMonth( _
DR_ActiveYear, DR_ActiveMonth)
For Each EmployeeKey In DR_SBByEmployee.Keys
If Not DE_EmployeeStates.Exists(CStr(EmployeeKey)) Then
ErrorResults.Add _
"ãæÙÝ ÇáÇÓÊÇäÏÈÇí ÑÞã " & CStr(EmployeeKey) & _
" ÛíÑ ãæÌæÏ Öãä ÍÇáÇÊ ÇáÊæÒíÚ."
Exit Function
End If
Set State = DE_EmployeeStates(CStr(EmployeeKey))
State("IsStandby") = True
SBGroup = UCase$(CStr(DR_SBByEmployee(EmployeeKey)))
Select Case SBGroup
Case "SB-1": GroupNumber = 1
Case "SB-2": GroupNumber = 2
Case "SB-3": GroupNumber = 3
Case Else
ErrorResults.Add _
"ÑãÒ ÇáÇÓÊÇäÏÈÇí " & SBGroup & _
" ÛíÑ ÕÍíÍ ááãæÙÝ " & CStr(EmployeeKey) & "."
Exit Function
End Select
For DayNumber = GroupNumber To DaysInMonth Step 3
DutyDate = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, DayNumber)
DE_AddAssignment _
State, Nothing, DE_TYPE_SB, SBGroup, _
DutyDate, DutyDate + 1, False, False
Next DayNumber
Next EmployeeKey
DE_RegisterStandby = True
End Function
'==========================================================
' ÊËÈíÊ ÑÍáÇÊ ÇáÅÏÇÑííä ÞÈá ÇáÊæÒíÚ ÇáÂáí
'==========================================================
Private Function DE_RegisterOfficeFlights( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim OfficeRecord As Object
Dim RunPlan As Object
Dim State As Object
Dim EmployeeNumber As String
Dim PairingNumber As String
Dim FlightDate As Date
Dim IsLeader As Boolean
Dim GroupCode As String
Dim ExistingLeader As String
Dim ExistingLeaderState As Object
Dim ConflictDetails As String
For Each OfficeRecord In DR_OfficeFlights
EmployeeNumber = CStr(OfficeRecord("EmployeeNumber"))
PairingNumber = CStr(OfficeRecord("PairingNumber"))
FlightDate = CDate(CDbl(OfficeRecord("FlightDate")))
If Not DE_EmployeeStates.Exists(EmployeeNumber) Then
ErrorResults.Add _
"ÇáÅÏÇÑí ÑÞã " & EmployeeNumber & _
" ÛíÑ ãæÌæÏ Öãä ÍÇáÇÊ ÇáÊæÒíÚ."
Exit Function
End If
Set RunPlan = DE_FindRun(PairingNumber, FlightDate)
If RunPlan Is Nothing Then
ErrorResults.Add _
"ÊÚÐÑ ÅíÌÇÏ ÊÔÛíá ÇáÈíÑäÞ " & PairingNumber & _
" ÈÊÇÑíÎ " & Format$(FlightDate, "dd/mm/yyyy") & _
" ÇáÎÇÕ ÈÇáÅÏÇÑí " & EmployeeNumber & "."
Exit Function
End If
Set State = DE_EmployeeStates(EmployeeNumber)
If CBool(State("IsNoFlightMonth")) Then
ErrorResults.Add _
"ÇáÅÏÇÑí ÑÞã " & EmployeeNumber & _
" áÏíå ÇÑÊÈÇØ ãÏÊå 30 íæãðÇ¡ æáÇ íÌæÒ " & _
"ÊËÈíÊ ÑÍáÉ áå ÎáÇá ÇáÔåÑ."
Exit Function
End If
If Not DE_EmployeeCanCoverCarrier( _
CStr(State("CarrierProfile")), _
CStr(RunPlan("CarrierCode"))) Then
ErrorResults.Add _
"ÇáÅÏÇÑí ÑÞã " & EmployeeNumber & _
" ãÄåá ÈÕÝÉ " & CStr(State("CarrierProfile")) & _
"¡ æáÇ íÓÊØíÚ ÊÛØíÉ ÇáÈíÑäÞ " & PairingNumber & _
" ÇáÊÇÈÚ ááäÇÞá " & _
CStr(RunPlan("CarrierCode")) & "."
Exit Function
End If
ConflictDetails = vbNullString
If Not DE_IsAvailable( _
State, CDate(RunPlan("StartDateTime")), _
CDate(RunPlan("EndDateTime")), _
ConflictDetails) Then
ErrorResults.Add _
"ÑÍáÉ ÇáÅÏÇÑí ÑÞã " & EmployeeNumber & _
"¡ ÇáÈíÑäÞ " & PairingNumber & _
"¡ ÈÊÇÑíÎ " & _
Format$(FlightDate, "dd/mm/yyyy") & _
" ÊÊÚÇÑÖ ãÚ ÝÊÑÉ ãÓÌáÉ ãÓÈÞðÇ." & _
vbCrLf & _
"ÇáÝÊÑÉ ÇáÌÏíÏÉ: " & _
Format$(CDate(RunPlan("StartDateTime")), _
"dd/mm/yyyy hh:mm") & _
" Åáì " & _
Format$(CDate(RunPlan("EndDateTime")), _
"dd/mm/yyyy hh:mm") & _
vbCrLf & ConflictDetails
Exit Function
End If
GroupCode = CStr(State("GroupCode"))
ExistingLeader = CStr(RunPlan("LeaderEmployee"))
IsLeader = False
Select Case GroupCode
Case "SSS", "SST"
If ExistingLeader <> vbNullString Then
Set ExistingLeaderState = _
DE_EmployeeStates(ExistingLeader)
If CStr(ExistingLeaderState("GroupCode")) = "STS" Then
DE_DemoteLeader _
ExistingLeaderState, RunPlan
ExistingLeader = vbNullString
End If
End If
IsLeader = True
Case "STS"
IsLeader = (ExistingLeader = vbNullString)
End Select
If IsLeader Then
If ExistingLeader <> vbNullString Then
WarningResults.Add _
"ÇáÈíÑäÞ " & PairingNumber & _
" ÈÊÇÑíÎ " & Format$(FlightDate, "dd/mm/yyyy") & _
" íÍÊæí ÃßËÑ ãä ÞÇÆÏ ÅÏÇÑí æÝÞ ÇáÇÎÊíÇÑ ÇáãÚÊãÏ."
Else
RunPlan("LeaderEmployee") = EmployeeNumber
End If
End If
DE_AddAssignment _
State, RunPlan, DE_TYPE_OFFICE, PairingNumber, _
CDate(RunPlan("StartDateTime")), _
CDate(RunPlan("EndDateTime")), _
CBool(RunPlan("IsLayover")), IsLeader
RunPlan("OfficeCount") = _
CLng(RunPlan("OfficeCount")) + 1
If RunPlan("AssignedEmployees").Count > _
CLng(RunPlan("RequiredCrew")) Then
WarningResults.Add _
"ÚÏÏ ÇáÅÏÇÑííä ÇáãÎÊÇÑíä Úáì ÇáÈíÑäÞ " & _
PairingNumber & " ÊÌÇæÒ ÚÏÏ ÇáØÇÞã ÇáãØáæÈ."
End If
Next OfficeRecord
DE_RegisterOfficeFlights = True
End Function
Private Sub DE_DemoteLeader( _
ByVal State As Object, _
ByVal RunPlan As Object)
Dim Assignment As Object
For Each Assignment In State("Assignments")
If CLng(Assignment("RunIndex"))
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: هذا هو كود R19 المطلوب فعلًا، لكنه وصل **مقطوعًا مرة أخرى** عند `DE_PREFERRED_FLIGHT_GAP_HOURS`. Auto Claude: أعط المستخدم أبسط طريقة لإرسال الموديول كاملًا دون أن تقطعه المحادثة، مع طريقة واضحة لتقسيمه بحيث نعرف أن جميع الأجزاء وصلت بالترتيب.
### Auto Claude (Claude Sonnet 5.5)
وصلني الكود المطلوب، لكنه انقطع مرة ثانية عند `DE_PREFERRED_FLIGHT_GAP_HOURS`، قبل أي إجراء فعلي. وفيه مشكلة ثانية: التعليقات العربية وصلت رموزًا مشوهة، وهذا لا يضر الكود نفسه لكنه يخفي شرح المنطق.
**أبسط طريقة لإرسال الموديول كاملًا:**
1. **أرسله ملفًا بدل النسخ واللصق.** في محرر VBA: كليك يمين على الموديول ثم **Export File** (ينتج ملف `.bas`). ارفعه كمرفق في المحادثة. هذا يتجاوز الانقطاع ويحفظ الترميز.
2. **إذا ما تيسر رفع الملف:** قسّم النص إلى أجزاء من نحو 300 سطر، وابدأ كل جزء بسطر مثل `--- جزء 1 من 4 ---`، وأنهِ آخر جزء بـ`--- نهاية الموديول ---`. هكذا نعرف أن الأجزاء كلها وصلت وبالترتيب.
3. **تقرير آخر تشغيل:** أرسله بنفس الطريقة، كنص أو لقطة شاشة.
**ملاحظة:** إذا كان الموديول ضخمًا جدًا (آلاف الأسطر)، أرسل الأجزاء حسب الأولوية: إجراءات المبيت، ثم الإصلاح.
بدون الإجراءات نفسها ما أقدر أحكم على شيء بعد.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: هل توافق أن **تصدير الموديول كملف `.bas` ورفعه هنا** هو الخيار الأفضل؟ وضّح للمستخدم فقط خطوات التصدير الدقيقة في VBA وكيف يتأكد أنه صدّر الموديول الصحيح، بدون بدائل إضافية تربكه.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
نعم، **ملف `.bas` هو الأفضل**؛ لأنه يعطينا الموديول كاملًا بدون انقطاع النص.
اعمل التالي فقط:
1. افتح VBA بـ **Alt + F11**.
2. من القائمة اليسرى اضغط على **الموديول الذي وجدت داخله تعليق `R19`**.
3. تأكد منه بفتح الموديول ورؤية بداية الكود التي أرسلتها الآن:
```vb
' R19 - ...
Public DE_Assignments As Collection
```
4. ارجع لاسم الموديول في القائمة اليسرى واضغط عليه **كليك يمين**.
5. اختر **Export File...**
6. ستظهر نافذة الحفظ. لا تغيّر نوع الملف؛ سيُحفظ بامتداد:
```text
.bas
```
7. اختر سطح المكتب مثلًا واضغط **Save**.
8. ارفع ملف الـ `.bas` هنا في المحادثة.
**لا تعدّل الكود ولا تحذف منه شيئًا قبل التصدير.** أرسله كما هو تمامًا، وأنا وAuto Claude نقرأه كاملًا ونحدد مسار مشكلة 135.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: صدّر الموديول الذي يحتوي `R19` كملف `.bas` وارفعه هنا كما هو؛ هذه أفضل طريقة لوصول الكود كاملًا.
**Agreed**
- افتح VBA وحدد الموديول الذي يحتوي تعليق `R19`.
- كليك يمين على اسم الموديول ثم **Export File...** واحفظ ملف `.bas`.
- لا تعدّل أو تحذف أي جزء من الكود قبل التصدير.
**What would change it**
- بعد استلام ملف `.bas` نقرأ المحرك كاملًا، ثم نحدد إن كنا نحتاج أي موديول إضافي.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Auto Claude: قبل أن نبدأ التحليل بعد رفع ملف `.bas`، ما أقل تقرير تشغيل نحتاجه بجانب الكود حتى نستطيع ربط مشكلة الرحلة 135 بمسار التنفيذ الفعلي، بدل تحليل الكود نظريًا فقط؟
### Participant
كيف يمكنني رفع ملف هنا
### Auto Claude (Claude Sonnet 5.5)
أرفع الملف من نفس المربع اللي تكتب فيه الرسائل، وطريقته تختلف حسب جهازك. وما أعرف بالضبط شكل واجهة هذه الغرفة، فإذا ما لقيت الزر المذكور، قل لي وش تشوف بجانب مربع الكتابة.
**على الكمبيوتر:**
1. ابحث بجانب مربع الكتابة عن أيقونة **مشبك ورق 📎** أو علامة **+**.
2. اضغط عليها واختر **Upload a file** (رفع ملف).
3. اختر ملف `.bas` من سطح المكتب واضغط **Open**.
4. انتظر حتى يظهر اسم الملف داخل مربع الكتابة، ثم أرسل الرسالة.
**على الجوال:** نفس الأيقونة (+ أو المشبك)، ثم اختر **Files** وحدد الملف.
**إذا ما ظهر خيار الرفع أو رفض الملف `.bas`:**
- غيّر امتداد الملف إلى `.txt` (مثلًا `engine.bas` يصير `engine.txt`) وارفعه، فبعض الأنظمة تقبل النصوص فقط.
- وإذا ما نفع، افتح الملف بالمفكرة (Notepad)، وانسخ النص على أجزاء مرقمة (1/4، 2/4...) وأرسلها.
**بجانب الكود:** لو تقدر، أرسل تقرير آخر تشغيل كامل، لأننا نحتاج أسطر القائد 135 فيه (عدد المحاولات وسبب التوقف).
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: المستخدم على الكمبيوتر؛ أعطه **طريقة واحدة فقط وأسهلها** لرفع ملف `.bas` هنا من واجهة ChatGPT، وإذا كان السحب والإفلات مباشرة داخل المحادثة يعمل فاجعله الخيار الأول لتجنب تشتيته بالبدائل.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
أسهل طريقة على الكمبيوتر:
افتح المجلد الذي حفظت فيه ملف **`.bas`**، ثم بالماوس **اسحب الملف نفسه وأسقطه مباشرة داخل مربع المحادثة هنا**، في نفس المكان الذي تكتب فيه رسالتك.
بعد أن يظهر اسم الملف كمرفق، اضغط **إرسال** فقط.
لا تفتح الملف ولا تغيّر امتداده ولا تضغطه. أرسله كما هو.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: اسحب ملف `.bas` من المجلد وأسقطه مباشرة داخل مربع المحادثة، ثم أرسله.
**Agreed**
- لا تفتح الملف ولا تعدّله.
- لا تغيّر امتداده ولا تضغطه.
- بعد ظهور اسم الملف كمرفق، اضغط إرسال.
**What would change it**
- إذا رفضت الواجهة الملف فعلًا، ننتقل وقتها لطريقة بديلة واحدة فقط.
### Participant
تظهر لي علامة ممنوع
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: واجهة المحادثة ترفض إسقاط ملف `.bas` مباشرة. Auto Claude: أعط المستخدم **بديلًا واحدًا فقط** هو الأسهل والأضمن لإرسال نفس الملف دون فقدان محتواه أو تشويه العربية.
### Participant
برسل لكم الكود على جزئين
بس لو تقولون لي الي اي جزء توقف بالضبط لاكمل لكم المتبقي منه
### Auto Claude (Claude Sonnet 5.5)
الكود الأول وصلني مقطوعًا عند هذا السطر بالضبط:
`Private Const DE_PREFERRED_FLIGHT_GAP_HOURS As Doubl`
الكلمة الأخيرة ناقصة (المفروض `Double`). فابدأ الجزء الثاني من هذا السطر نفسه، وأعد كتابته كاملًا:
`Private Const DE_PREFERRED_FLIGHT_GAP_HOURS As Double = ...`
ثم أكمل كل ما بعده بدون حذف.
**ملاحظات تسهّل الإرسال:**
1. ابدأ كل رسالة بسطر `--- جزء 1 من 2 ---` والثانية `--- جزء 2 من 2 ---`، وفي آخر الثانية اكتب `--- نهاية الموديول ---`.
2. إذا انقطع الجزء الثاني أيضًا، سأقول لك آخر سطر وصل، وترسل من عنده.
3. التعليقات العربية تصل رموزًا مشوهة. لا يضر المنطق، لكن لو تقدر تنسخ النص من محرر VBA مباشرة بدل الملف الخارجي فقد يتحسن.
وبعد الكود أرسل تقرير آخر تشغيل كامل، خصوصًا أسطر القائد 135.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: أكّد نقطة البداية للجزء المتبقي، وهل الأفضل أن يعيد المستخدم السطر المقطوع كاملًا مع بضعة أسطر قبله لضمان عدم فقدان أي سطر عند نقطة الفصل؟
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
نعم. **ابدأ الجزء المتبقي من قبل مكان الانقطاع بقليل** حتى نضمن عدم سقوط أي سطر بين الجزأين.
آخر ما وصلنا كان:
```vb
Private Const DE_PREFERRED_FLIGHT_GAP_HOURS As Doubl
```
لذلك عند إرسال الجزء الثاني، ارجع في الكود **حوالي 5 أسطر قبل هذا السطر**، ثم انسخ من هناك إلى **نهاية الموديول بالكامل**.
لا يضر تكرار هذه الأسطر الخمسة؛ بالعكس، سيساعدنا على التأكد أن الجزأين متصلان بشكل صحيح.
وفي آخر الرسالة اكتب فقط:
`--- نهاية الموديول ---`
وبذلك نعرف يقينًا أن R19 وصل كاملًا.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: أرسل الجزء الثاني بدءًا من نحو **5 أسطر قبل** `Private Const DE_PREFERRED_FLIGHT_GAP_HOURS...` وحتى آخر سطر في الموديول.
**Agreed**
- تكرار عدة أسطر بين الجزأين مطلوب للتأكد من عدم فقدان شيء.
- أكمل النسخ حتى نهاية الموديول دون حذف.
- اختم الرسالة بـ `--- نهاية الموديول ---`.
### Participant
' تفضيلات تشغيلية لتباعد الرحلات. هذه ليست منعًا مطلقًا؛
' فالحد الإلزامي يبقى راحة 24 ساعة، بينما يستخدم المحرك
' هذه القيم لاختيار الموظف صاحب الجدول الأقل ازدحامًا.
Private Const DE_PREFERRED_FLIGHT_GAP_HOURS As Double = 72#
Private Const DE_ACCEPTABLE_FLIGHT_GAP_HOURS As Double = 48#
'==========================================================
' بناء خطة التوزيع كاملة في الذاكرة
'==========================================================
Public Function DistributionEngine_BuildPlan( _
ByRef ErrorResults As Collection, _
ByRef PassedResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim CurrentStep As String
Dim ReaderPassed As Boolean
Dim ValidationPassed As Boolean
On Error GoTo EngineError
EnsureGregorianCalendar
DE_EnsureCollections ErrorResults, PassedResults, WarningResults
DistributionEngine_Clear
Set DE_Warnings = WarningResults
CurrentStep = "تحميل مصادر بيانات التوزيع"
If DR_Employees Is Nothing Then
ReaderPassed = DistributionReader_LoadAll( _
ErrorResults, PassedResults)
ElseIf DR_Employees.Count = 0 Then
ReaderPassed = DistributionReader_LoadAll( _
ErrorResults, PassedResults)
Else
ReaderPassed = True
End If
If Not ReaderPassed Then Exit Function
ValidationPassed = True
CurrentStep = "تجهيز حالات الموظفين"
If Not DE_InitializeEmployeeStates(ErrorResults) Then
ValidationPassed = False
End If
CurrentStep = "تحليل مرات تشغيل البيرنقات"
If Not DE_InitializeRunPlans(ErrorResults, PassedResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
CurrentStep = "تثبيت ارتباطات الموظفين"
If Not DE_RegisterEvents( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
CurrentStep = "تثبيت جداول الاستاندباي"
If Not DE_RegisterStandby(ErrorResults) Then
ValidationPassed = False
End If
CurrentStep = "تثبيت رحلات الإداريين"
If Not DE_RegisterOfficeFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
' يجب حجز أيام الاحتياط قبل توزيع الرحلات العادية؛
' حتى تُبنى الرحلات حول الاحتياط وفترة الراحة التالية له.
CurrentStep = "توزيع أيام الاحتياط"
If Not DE_DistributeReserveDays( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
' الاحتياط تكليف إلزامي. إذا تعذر حجز يوم مناسب له،
' لا يبدأ توزيع الرحلات على خطة ناقصة أو غير قابلة للتنفيذ.
If Not ValidationPassed Then Exit Function
' الرحلات المطالب بها من الشهر السابق تُثبت قبل التوزيع
' العادي؛ لأنها حق مرحّل للموظف وتُعد رحلة إضافية فوق
' مستهدفه الأساسي، مع تطبيق الأهلية والتعارض وراحة 24 ساعة.
CurrentStep = "توزيع الرحلات المطالب بها"
If Not DE_DistributeCarryoverFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
If Not ValidationPassed Then Exit Function
CurrentStep = "توزيع أطقم الرحلات"
If Not DE_DistributeFlights( _
ErrorResults, WarningResults) Then
ValidationPassed = False
End If
CurrentStep = "مراجعة ترتيب القيادة والأفراد"
If Not DE_ValidateRolePolicy(ErrorResults) Then
ValidationPassed = False
End If
' يضاف الملخص سواء نجحت الخطة أم ظهر عجز؛ حتى يوضح
' عدد الرحلات الإضافية المستخدمة فعليًا حسب المجموعة.
DE_AddExtraFlightSummary WarningResults
CurrentStep = "مراجعة توافق تأهيل الموظفين مع الناقلات"
If ValidationPassed Then
If Not DE_ValidateCarrierAssignments(ErrorResults) Then
ValidationPassed = False
End If
End If
If ValidationPassed Then
PassedResults.Add _
"نجح إنشاء خطة توزيع الرحلات في الذاكرة."
PassedResults.Add _
"عدد مرات التشغيل المخططة: " & _
CStr(DE_RunPlans.Count) & _
"، وعدد التكليفات: " & _
CStr(DE_Assignments.Count) & "."
PassedResults.Add _
"لم يتم تعديل أي خلية في شيت LINE."
PassedResults.Add _
"تكليفات الرحلات حسب الناقل: السعودية " & _
CStr(DE_CarrierAssignmentCount("SAUDIA")) & _
"، ناس " & CStr(DE_CarrierAssignmentCount("NAS")) & _
"، أديل " & CStr(DE_CarrierAssignmentCount("ADEAL")) & "."
PassedResults.Add _
"تمت تغطية الرحلات المطالب بها: " & _
CStr(DE_CarryoverAssignedCount()) & _
" من " & CStr(DR_CarryoverFlights.Count) & "."
PassedResults.Add _
"راحة بداية الشهر بسبب آخر رحلة في الشهر السابق: " & _
"يوم واحد لعدد " & _
CStr(DE_PreviousMonthRestOneDayCount) & _
"، يومان لعدد " & _
CStr(DE_PreviousMonthRestTwoDaysCount) & _
"، ثلاثة أيام لعدد " & _
CStr(DE_PreviousMonthRestThreeDaysCount) & _
"، والإجمالي " & _
CStr(DE_PreviousMonthRestCount) & " موظفًا."
End If
DistributionEngine_BuildPlan = ValidationPassed
Exit Function
EngineError:
DE_EnsureCollections ErrorResults, PassedResults, WarningResults
ErrorResults.Add _
"تعذر بناء خطة التوزيع أثناء " & CurrentStep & _
". تفاصيل الخطأ: " & Err.Description
DistributionEngine_BuildPlan = False
End Function
'==========================================================
' مسح خطة سابقة من الذاكرة
'==========================================================
Public Sub DistributionEngine_Clear()
Set DE_Assignments = New Collection
Set DE_RunPlans = New Collection
Set DE_EmployeeStates = _
CreateObject("Scripting.Dictionary")
DE_EmployeeStates.CompareMode = vbTextCompare
Set DE_Warnings = New Collection
Set DE_RTDayLoad = CreateObject("Scripting.Dictionary")
DE_RTDayLoad.CompareMode = vbTextCompare
DE_PreviousMonthRestCount = 0
DE_PreviousMonthRestOneDayCount = 0
DE_PreviousMonthRestTwoDaysCount = 0
DE_PreviousMonthRestThreeDaysCount = 0
End Sub
'==========================================================
' اختبار مستقل للمحرك من دون الكتابة في LINE
'==========================================================
Public Sub TestDistributionEngine()
Dim Errors As Collection
Dim Passed As Collection
Dim Warnings As Collection
Dim ResultPassed As Boolean
Set Errors = New Collection
Set Passed = New Collection
Set Warnings = New Collection
ResultPassed = DistributionEngine_BuildPlan( _
Errors, Passed, Warnings)
DE_WriteDistributionTestReport _
ResultPassed, Errors, Warnings, Passed
MsgBox _
"تم إنشاء تقرير اختبار التوزيع في شيت " & _
"DISTRIBUTION_REPORT.", _
IIf(ResultPassed, vbInformation, vbExclamation), _
"اختبار محرك التوزيع"
End Sub
'==========================================================
' إنشاء تقرير اختبار المحرك داخل شيت مستقل.
'
' لا يكتب هذا الإجراء أي شيء في LINE، ولا يحذف الشيت؛
' بل يمسح محتوى التقرير السابق ثم يكتب التقرير الجديد.
'==========================================================
Private Sub DE_WriteDistributionTestReport( _
ByVal ResultPassed As Boolean, _
ByVal ErrorResults As Collection, _
ByVal WarningResults As Collection, _
ByVal PassedResults As Collection)
Const REPORT_SHEET As String = _
"DISTRIBUTION_REPORT"
Dim ws As Worksheet
Dim NextRow As Long
Dim SequenceNumber As Long
Dim FinalRow As Long
Dim ReportRange As Range
Dim ReportWindow As Window
Dim PreviousScreenUpdating As Boolean
Dim ReportErrorNumber As Long
Dim ReportErrorDescription As String
PreviousScreenUpdating = Application.ScreenUpdating
On Error GoTo ReportError
Set ws = DE_GetOrCreateReportSheet(REPORT_SHEET)
Application.ScreenUpdating = False
ws.Visible = xlSheetVisible
ws.Cells.Clear
ws.DisplayRightToLeft = True
' عنوان التقرير.
With ws.Range("A1:D1")
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Bold = True
.Font.Size = 16
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(0, 78, 76)
End With
ws.Range("A1").Value = _
"تقرير اختبار محرك توزيع الرحلات"
ws.Rows(1).RowHeight = 28
ws.Range("A2").Value = "الشهر"
ws.Range("B2").Value = _
UCase$(MonthName(DR_ActiveMonth, True))
ws.Range("C2").Value = "السنة"
ws.Range("D2").Value = DR_ActiveYear
ws.Range("A3").Value = "نتيجة الاختبار"
If ResultPassed Then
ws.Range("B3").Value = "نجح الاختبار"
ws.Range("B3").Interior.Color = _
RGB(198, 239, 206)
ws.Range("B3").Font.Color = _
RGB(0, 97, 0)
Else
ws.Range("B3").Value = "لم تكتمل خطة التوزيع"
ws.Range("B3").Interior.Color = _
RGB(255, 199, 206)
ws.Range("B3").Font.Color = _
RGB(156, 0, 6)
End If
ws.Range("C3").Value = "تاريخ التقرير"
ws.Range("D3").NumberFormat = "@"
ws.Range("D3").Value = _
"'" & Format$(Now, "dd/mm/yyyy hh:mm")
With ws.Range("A2:D3")
.Borders.LineStyle = xlContinuous
.VerticalAlignment = xlCenter
.Font.Bold = True
End With
' رؤوس أعمدة النتائج.
ws.Range("A5").Value = "التسلسل"
ws.Range("B5").Value = "التصنيف"
ws.Range("C5").Value = "الحالة"
ws.Range("D5").Value = "التفاصيل"
With ws.Range("A5:D5")
.Font.Bold = True
.Font.Color = RGB(255, 255, 255)
.Interior.Color = RGB(0, 78, 76)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
End With
NextRow = 6
SequenceNumber = 0
DE_WriteReportCollection _
ws, ErrorResults, "خطأ", _
NextRow, SequenceNumber
DE_WriteReportCollection _
ws, WarningResults, "تنبيه", _
NextRow, SequenceNumber
DE_WriteReportCollection _
ws, PassedResults, "سليم", _
NextRow, SequenceNumber
If SequenceNumber = 0 Then
SequenceNumber = 1
ws.Cells(NextRow, "A").Value = SequenceNumber
ws.Cells(NextRow, "B").Value = "معلومة"
ws.Cells(NextRow, "C").Value = "لا توجد نتائج"
ws.Cells(NextRow, "D").Value = _
"لم يُرجع المحرك أي نتائج لعرضها."
NextRow = NextRow + 1
End If
FinalRow = NextRow - 1
Set ReportRange = ws.Range( _
"A5:D" & CStr(FinalRow))
With ReportRange
.Borders.LineStyle = xlContinuous
.VerticalAlignment = xlTop
End With
ws.Range("A6:C" & CStr(FinalRow)).HorizontalAlignment = _
xlCenter
ws.Range("D6:D" & CStr(FinalRow)).HorizontalAlignment = _
xlRight
ws.Range("D6:D" & CStr(FinalRow)).WrapText = True
ws.Columns("A").ColumnWidth = 10
ws.Columns("B").ColumnWidth = 16
ws.Columns("C").ColumnWidth = 20
ws.Columns("D").ColumnWidth = 95
ws.Rows("2:3").AutoFit
ws.Rows("5:" & CStr(FinalRow)).AutoFit
If ws.AutoFilterMode Then ws.AutoFilterMode = False
ws.Range("A5:D" & CStr(FinalRow)).AutoFilter
' إعداد عرض التقرير اختياري ولا يوقف كتابة النتائج.
On Error Resume Next
ws.Parent.Activate
ws.Activate
Set ReportWindow = Application.ActiveWindow
If Not ReportWindow Is Nothing Then
ReportWindow.View = xlNormalView
ReportWindow.FreezePanes = False
ReportWindow.SplitRow = 0
ReportWindow.SplitColumn = 0
Err.Clear
ws.Range("A6").Select
If Err.Number = 0 Then
ReportWindow.SplitRow = 5
ReportWindow.FreezePanes = True
End If
End If
Err.Clear
On Error GoTo ReportError
Application.ScreenUpdating = PreviousScreenUpdating
Exit Sub
ReportError:
ReportErrorNumber = Err.Number
ReportErrorDescription = Err.Description
Application.ScreenUpdating = PreviousScreenUpdating
MsgBox "تعذر إخراج التقرير. رقم الخطأ: " & CStr(ReportErrorNumber) & _
vbCrLf & ReportErrorDescription, vbExclamation, "تقرير التوزيع"
End Sub
'==========================================================
' إرجاع شيت التقرير أو إنشاؤه إذا لم يكن موجودًا.
'==========================================================
Private Function DE_GetOrCreateReportSheet( _
ByVal SheetName As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(SheetName)
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add( _
After:=ThisWorkbook.Worksheets( _
ThisWorkbook.Worksheets.Count))
ws.NAME = SheetName
End If
Set DE_GetOrCreateReportSheet = ws
End Function
'==========================================================
' كتابة مجموعة نتائج في تقرير الاختبار.
'==========================================================
Private Sub DE_WriteReportCollection( _
ByVal ws As Worksheet, _
ByVal Results As Collection, _
ByVal DefaultCategory As String, _
ByRef NextRow As Long, _
ByRef SequenceNumber As Long)
Dim Item As Variant
Dim ResultText As String
Dim CategoryText As String
Dim StatusText As String
If Results Is Nothing Then Exit Sub
For Each Item In Results
ResultText = CStr(Item)
CategoryText = DefaultCategory
StatusText = DefaultCategory
If DE_IsShortageDiagnostic(ResultText) Then
CategoryText = "تشخيص عجز"
StatusText = "تفاصيل الموانع"
ElseIf DefaultCategory = "خطأ" _
And InStr(1, ResultText, _
"عجز", vbTextCompare) > 0 Then
CategoryText = "عجز"
StatusText = "غير مغطى"
ElseIf DefaultCategory = "خطأ" Then
StatusText = "يحتاج معالجة"
ElseIf DefaultCategory = "تنبيه" Then
StatusText = "للمراجعة"
ElseIf DefaultCategory = "سليم" Then
StatusText = "مكتمل"
End If
SequenceNumber = SequenceNumber + 1
ws.Cells(NextRow, "A").Value = SequenceNumber
ws.Cells(NextRow, "B").Value = CategoryText
ws.Cells(NextRow, "C").Value = StatusText
ws.Cells(NextRow, "D").Value = ResultText
DE_ApplyReportRowColor _
ws.Range("A" & CStr(NextRow) & _
":D" & CStr(NextRow)), _
CategoryText
NextRow = NextRow + 1
Next Item
End Sub
'==========================================================
' تلوين صف التقرير حسب نوع النتيجة.
'==========================================================
Private Sub DE_ApplyReportRowColor( _
ByVal TargetRange As Range, _
ByVal CategoryText As String)
Select Case CategoryText
Case "خطأ"
TargetRange.Interior.Color = _
RGB(255, 199, 206)
TargetRange.Font.Color = _
RGB(156, 0, 6)
Case "عجز", "تشخيص عجز"
TargetRange.Interior.Color = _
RGB(252, 229, 205)
TargetRange.Font.Color = _
RGB(156, 87, 0)
Case "تنبيه"
TargetRange.Interior.Color = _
RGB(255, 242, 204)
TargetRange.Font.Color = _
RGB(127, 96, 0)
Case "سليم"
TargetRange.Interior.Color = _
RGB(198, 239, 206)
TargetRange.Font.Color = _
RGB(0, 97, 0)
Case Else
TargetRange.Interior.Color = _
RGB(217, 217, 217)
TargetRange.Font.Color = _
RGB(0, 0, 0)
End Select
End Sub
'==========================================================
' التحقق من أن النص تقرير تشخيص عجز تفصيلي.
'==========================================================
Private Function DE_IsShortageDiagnostic( _
ByVal ResultText As String) As Boolean
DE_IsShortageDiagnostic = _
(Left$(Trim$(ResultText), _
Len("[تشخيص]")) = "[تشخيص]" _
Or Left$(Trim$(ResultText), Len("[أهلية فعلية")) = "[أهلية فعلية")
End Function
'==========================================================
' عرض تقارير تشخيص العجز في رسائل منفصلة.
'==========================================================
Private Sub DE_ShowShortageDiagnostics( _
ByVal ErrorResults As Collection)
Dim Item As Variant
Dim DiagnosticNumber As Long
If ErrorResults Is Nothing Then Exit Sub
For Each Item In ErrorResults
If DE_IsShortageDiagnostic(CStr(Item)) Then
DiagnosticNumber = DiagnosticNumber + 1
DE_ShowLongDiagnostic _
CStr(Item), _
"تفاصيل عجز التوزيع " & _
CStr(DiagnosticNumber)
End If
Next Item
End Sub
'==========================================================
' تقسيم التقرير الطويل إلى صفحات من دون قطع السطور.
'==========================================================
Private Sub DE_ShowLongDiagnostic( _
ByVal DiagnosticText As String, _
ByVal WindowTitle As String)
Const MAX_PAGE_LENGTH As Long = 650
Dim Lines As Variant
Dim LineItem As Variant
Dim CurrentPage As String
Dim Pages As Collection
Dim PageNumber As Long
Dim CandidateText As String
Set Pages = New Collection
Lines = Split(DiagnosticText, vbCrLf)
For Each LineItem In Lines
If CurrentPage = vbNullString Then
CandidateText = CStr(LineItem)
Else
CandidateText = CurrentPage & _
vbCrLf & CStr(LineItem)
End If
If Len(CandidateText) > MAX_PAGE_LENGTH _
And CurrentPage <> vbNullString Then
Pages.Add CurrentPage
CurrentPage = CStr(LineItem)
Else
CurrentPage = CandidateText
End If
Next LineItem
If CurrentPage <> vbNullString Then
Pages.Add CurrentPage
End If
For PageNumber = 1 To Pages.Count
MsgBox _
CStr(Pages(PageNumber)), _
vbExclamation, _
WindowTitle & " - الصفحة " & _
CStr(PageNumber) & " من " & _
CStr(Pages.Count)
Next PageNumber
End Sub
'==========================================================
' تجهيز حالة كل موظف ومستهدف مجموعته
'==========================================================
Private Function DE_GroupFlightTarget(ByVal GroupCode As String) As Long
Select Case UCase$(Trim$(GroupCode))
Case "SSS", "SST": DE_GroupFlightTarget = 7
Case "STS": DE_GroupFlightTarget = 8
Case "STT": DE_GroupFlightTarget = 10
End Select
End Function
Private Function DE_InitializeEmployeeStates( _
ByRef ErrorResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim EmployeeRecord As Object
Dim State As Object
Dim Targets As Object
Dim GroupCode As String
Dim BusyPeriods As Collection
Dim EmployeeAssignments As Collection
Dim EventDates As Object
Dim PreviousLastFlightDate As Date
Dim PreviousMonthEnd As Date
Dim NewMonthStart As Date
Dim PreviousMonthRestEnd As Date
Dim PreviousMonthRestDays As Long
Dim PreviousTripType As String
Set Targets = DE_ReadGroupTargets(ErrorResults)
If Targets Is Nothing Then Exit Function
For Each EmployeeKey In DR_Employees.Keys
Set EmployeeRecord = DR_Employees(EmployeeKey)
GroupCode = UCase$(CStr(EmployeeRecord("GroupCode")))
If Not Targets.Exists(GroupCode) Then
ErrorResults.Add _
"لا يوجد مستهدف للمجموعة " & GroupCode & _
" الخاصة بالموظف " & CStr(EmployeeKey) & "."
Exit Function
End If
Set State = DE_NewRecord()
State.Add "EmployeeNumber", CStr(EmployeeKey)
State.Add "EmployeeName", _
CStr(EmployeeRecord("EmployeeName"))
State.Add "GroupCode", GroupCode
State.Add "CarrierProfile", _
UCase$(CStr(EmployeeRecord("CarrierProfile")))
State.Add "InfoRow", CLng(EmployeeRecord("InfoRow"))
State.Add "LineRow", CLng(EmployeeRecord("LineRow"))
State.Add "IsOffice", CBool(EmployeeRecord("IsOffice"))
State.Add "IsHold", CBool(EmployeeRecord("IsHold"))
State.Add "IsStandby", _
DR_SBByEmployee.Exists(CStr(EmployeeKey))
State.Add "OriginalFlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "NormalFlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "FlightTarget", _
DE_GroupFlightTarget(GroupCode)
State.Add "OriginalLayoverTarget", _
CLng(Targets(GroupCode)("Layovers"))
State.Add "LayoverTarget", _
CLng(Targets(GroupCode)("Layovers"))
State.Add "LongLayoverTarget", 0&
State.Add "ShortLayoverTarget", 0&
State.Add "LongLayoverCount", 0&
State.Add "ShortLayoverCount", 0&
State.Add "EventDayCount", 0&
State.Add "LongestEventDays", 0&
State.Add "TargetAdjustmentReason", vbNullString
State.Add "IsNoFlightMonth", False
State.Add "SaudiaTarget", 0&
State.Add "SpecialCarrierTarget", 0&
State.Add "SpecialCarrierCode", vbNullString
State.Add "SaudiaCount", 0&
State.Add "SpecialCarrierCount", 0&
State.Add "FlightCount", 0&
State.Add "LayoverCount", 0&
State.Add "CarryoverTarget", _
DE_EmployeeCarryoverCount(CStr(EmployeeKey))
State.Add "CarryoverAssigned", 0&
State.Add "CarryoverLayoverCount", 0&
State.Add "CarryoverLongLayoverCount", 0&
State.Add "CarryoverShortLayoverCount", 0&
State.Add "CarryoverSaudiaTarget", _
DE_EmployeeCarryoverCarrierCount( _
CStr(EmployeeKey), "SAUDIA")
State.Add "CarryoverSpecialTarget", _
DE_EmployeeCarryoverSpecialCount( _
CStr(EmployeeKey))
State.Add "LeaderCount", 0&
State.Add "ReserveCount", 0&
State.Add "HasPreviousMonthEndRest", False
' عدد الرحلات التي أضيفت فوق مستهدف المجموعة لمعالجة العجز
State.Add "ExtraFlightCount", 0&
Set BusyPeriods = New Collection
Set EmployeeAssignments = New Collection
Set EventDates = CreateObject("Scripting.Dictionary")
EventDates.CompareMode = vbTextCompare
State.Add "BusyPeriods", BusyPeriods
State.Add "Assignments", EmployeeAssignments
State.Add "EventDates", EventDates
' إذا كانت آخر رحلة للموظف في آخر يوم من الشهر السابق،
' تُحجز راحة بداية الشهر حسب تصنيف الرحلة السابقة:
' LAY = ثلاثة أيام، LNG أو MED = يومان، SHT = يوم واحد.
' وتستمر بقية شروط الراحة والتعارض دون أي تغيير.
If EmployeeRecord.Exists("HasPreviousLastFlight") Then
If CBool(EmployeeRecord("HasPreviousLastFlight")) Then
PreviousLastFlightDate = CDate(CDbl( _
EmployeeRecord("PreviousLastFlightDate")))
PreviousMonthEnd = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 0)
If Int(CDbl(PreviousLastFlightDate)) = _
Int(CDbl(PreviousMonthEnd)) Then
NewMonthStart = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 1)
PreviousMonthRestDays = _
DE_GetPreviousMonthRestDays( _
EmployeeRecord, PreviousTripType)
PreviousMonthRestEnd = DateAdd( _
"d", PreviousMonthRestDays, NewMonthStart)
DE_AddBusyPeriod _
State, _
NewMonthStart, _
PreviousMonthRestEnd, _
DE_TYPE_PREVIOUS_MONTH_REST, _
False, _
"راحة بداية الشهر لمدة " & _
DE_ArabicDayPhrase(PreviousMonthRestDays) & _
" بسبب رحلة " & PreviousTripType & _
" في آخر يوم من الشهر السابق"
State("HasPreviousMonthEndRest") = True
DE_PreviousMonthRestCount = _
DE_PreviousMonthRestCount + 1
Select Case PreviousMonthRestDays
Case 1
DE_PreviousMonthRestOneDayCount = _
DE_PreviousMonthRestOneDayCount + 1
Case 2
DE_PreviousMonthRestTwoDaysCount = _
DE_PreviousMonthRestTwoDaysCount + 1
Case 3
DE_PreviousMonthRestThreeDaysCount = _
DE_PreviousMonthRestThreeDaysCount + 1
End Select
End If
End If
End If
DE_EmployeeStates.Add CStr(EmployeeKey), State
Next EmployeeKey
DE_InitializeEmployeeStates = True
End Function
'==========================================================
' حساب عدد المطالبات المسجلة لموظف
'==========================================================
Private Function DE_EmployeeCarryoverCount( _
ByVal EmployeeNumber As String) As Long
Dim CarryoverRecord As Object
For Each CarryoverRecord In DR_CarryoverFlights
If StrComp(CStr(CarryoverRecord("EmployeeNumber")), _
EmployeeNumber, vbTextCompare) = 0 Then
DE_EmployeeCarryoverCount = _
DE_EmployeeCarryoverCount + 1
End If
Next CarryoverRecord
End Function
'==========================================================
' حساب مطالبات موظف لناقل محدد
'==========================================================
Private Function DE_EmployeeCarryoverCarrierCount( _
ByVal EmployeeNumber As String, _
ByVal CarrierCode As String) As Long
Dim CarryoverRecord As Object
For Each CarryoverRecord In DR_CarryoverFlights
If StrComp(CStr(CarryoverRecord("EmployeeNumber")), _
EmployeeNumber, vbTextCompare) = 0 _
And StrComp(CStr(CarryoverRecord("CarrierCode")), _
CarrierCode, vbTextCompare) = 0 Then
DE_EmployeeCarryoverCarrierCount = _
DE_EmployeeCarryoverCarrierCount + 1
End If
Next CarryoverRecord
End Function
'==========================================================
' حساب مطالبات الموظف للناقل المتخصص في ملفه
'==========================================================
Private Function DE_EmployeeCarryoverSpecialCount( _
ByVal EmployeeNumber As String) As Long
Dim EmployeeRecord As Object
Dim SpecialCarrier As String
If Not DR_Employees.Exists(EmployeeNumber) Then Exit Function
Set EmployeeRecord = DR_Employees(EmployeeNumber)
Select Case UCase$(CStr(EmployeeRecord("CarrierProfile")))
Case "SAUDIA_NAS": SpecialCarrier = "NAS"
Case "SAUDIA_ADEAL": SpecialCarrier = "ADEAL"
Case Else: Exit Function
End Select
DE_EmployeeCarryoverSpecialCount = _
DE_EmployeeCarryoverCarrierCount( _
EmployeeNumber, SpecialCarrier)
End Function
'==========================================================
' قراءة مستهدف الرحلات والمبيت من INFO!K:M
'==========================================================
Private Function DE_ReadGroupTargets( _
ByRef ErrorResults As Collection) As Object
Dim ws As Worksheet
Dim Targets As Object
Dim LastRow As Long
Dim CurrentRow As Long
Dim GroupCode As String
Dim FlightsText As String
Dim LayoversText As String
Dim Target As Object
Set ws = ThisWorkbook.Worksheets(DE_INFO)
Set Targets = CreateObject("Scripting.Dictionary")
Targets.CompareMode = vbTextCompare
LastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row
For CurrentRow = 1 To LastRow
GroupCode = UCase$(DE_Text( _
ws.Cells(CurrentRow, "K").Value2))
If DE_IsGroupCode(GroupCode) Then
FlightsText = DE_Text( _
ws.Cells(CurrentRow, "L").Value2)
LayoversText = DE_Text( _
ws.Cells(CurrentRow, "M").Value2)
If Not DE_IsDigits(FlightsText) _
Or Not DE_IsDigits(LayoversText) Then
ErrorResults.Add _
"مستهدف المجموعة " & GroupCode & _
" غير صحيح في INFO!K:M."
Exit Function
End If
Set Target = DE_NewRecord()
Target.Add "Flights", CLng(FlightsText)
Target.Add "Layovers", CLng(LayoversText)
If Targets.Exists(GroupCode) Then
Targets.Remove GroupCode
End If
Targets.Add GroupCode, Target
End If
Next CurrentRow
If Targets.Count <> 4 Then
ErrorResults.Add _
"تعذر قراءة مستهدفات المجموعات الأربع من INFO!K:M."
Exit Function
End If
Set DE_ReadGroupTargets = Targets
End Function
'==========================================================
' تحليل كل مرة تشغيل وإضافة تفاصيلها اللازمة للتوزيع
'==========================================================
Private Function DE_InitializeRunPlans( _
ByRef ErrorResults As Collection, _
ByRef PassedResults As Collection) As Boolean
Dim ws As Worksheet
Dim SourceRun As Object
Dim RunPlan As Object
Dim SortedRuns() As Object
Dim RunCount As Long
Dim Index As Long
Dim SwapIndex As Long
Dim TempRun As Object
Set ws = ThisWorkbook.Worksheets(DE_PAIRING)
RunCount = DR_PairingRuns.Count
If RunCount = 0 Then
ErrorResults.Add "لا توجد مرات تشغيل جاهزة للتوزيع."
Exit Function
End If
ReDim SortedRuns(1 To RunCount)
For Index = 1 To RunCount
Set SourceRun = DR_PairingRuns(Index)
Set RunPlan = DE_BuildRunPlan( _
ws, SourceRun, ErrorResults)
If RunPlan Is Nothing Then Exit Function
Set SortedRuns(Index) = RunPlan
PassedResults.Add "[تصنيف البيرنق] " & _
CStr(RunPlan("PairingNumber")) & " بتاريخ " & _
Format$(CDate(RunPlan("OperatingDate")), "dd/mm/yyyy") & _
": " & CStr(RunPlan("LayoverEvidence"))
Next Index
' ترتيب زمني ثابت؛ وعند تساوي التاريخ يرتب برقم البيرنق.
For Index = 1 To RunCount - 1
For SwapIndex = Index + 1 To RunCount
If DE_RunComesAfter( _
SortedRuns(Index), SortedRuns(SwapIndex)) Then
Set TempRun = SortedRuns(Index)
Set SortedRuns(Index) = SortedRuns(SwapIndex)
Set SortedRuns(SwapIndex) = TempRun
End If
Next SwapIndex
Next Index
For Index = 1 To RunCount
SortedRuns(Index)("RunIndex") = Index
DE_RunPlans.Add SortedRuns(Index)
Next Index
DE_InitializeRunPlans = True
End Function
Private Function DE_BuildRunPlan( _
ByVal ws As Worksheet, _
ByVal SourceRun As Object, _
ByRef ErrorResults As Collection) As Object
Dim StartRow As Long
Dim CreditRow As Long
Dim StartColumn As Long
Dim EndColumn As Long
Dim DetailRow As Long
Dim FirstFlightRow As Long
Dim LastFlightRow As Long
Dim LayoverRow As Long
Dim HotelName As String
Dim CandidateHotel As String
Dim HotelColumn As Long
Dim DurationText As String
Dim FlightDayCode As String
Dim FirstDayCode As String
Dim LastDayCode As String
Dim StationCode As String
Dim LayoverStation As String
Dim LayoverClass As String
Dim LayoverHours As Double
Dim TripType As String
Dim RequiredCrew As Long
Dim StartClock As Double
Dim EndClock As Double
Dim DayOffset As Long
Dim OperatingDate As Date
Dim StartDateTime As Date
Dim EndDateTime As Date
Dim RunPlan As Object
Dim AssignedEmployees As Collection
StartRow = CLng(SourceRun("StartRow"))
CreditRow = CLng(SourceRun("CreditRow"))
StartColumn = CLng(SourceRun("StartColumn"))
EndColumn = CLng(SourceRun("EndColumn"))
FirstDayCode = UCase$(CStr(SourceRun("DayCode")))
OperatingDate = CDate(CDbl(SourceRun("OperatingDate")))
For DetailRow = StartRow + 2 To CreditRow - 1
FlightDayCode = UCase$(DE_Text( _
ws.Cells(DetailRow, StartColumn).Value2))
If DE_IsDayCode(FlightDayCode) Then
If FirstFlightRow = 0 Then FirstFlightRow = DetailRow
LastFlightRow = DetailRow
ElseIf DE_RowHasData( _
ws, DetailRow, StartColumn, EndColumn) Then
' اسم الفندق يقع قبل عمودي محطة المبيت ومدته.
' تجاهل الصفوف الفارغة والملاحظات التي لا تحمل بيانات مبيت.
CandidateHotel = vbNullString
For HotelColumn = StartColumn To StartColumn + 7
If Not IsError(ws.Cells(DetailRow, HotelColumn).Value2) Then
DurationText = DE_Text( _
ws.Cells(DetailRow, HotelColumn).Value2)
If DurationText <> vbNullString Then
If Not IsNumeric(DurationText) Then
If CandidateHotel <> vbNullString Then _
CandidateHotel = CandidateHotel & " "
CandidateHotel = CandidateHotel & DurationText
End If
End If
End If
Next HotelColumn
DurationText = DE_Text( _
ws.Cells(DetailRow, StartColumn + 9).Value2)
' لا يكفي اختلاف يوم العودة أو اسم المحطة لإثبات المبيت.
If CandidateHotel <> vbNullString Or _
DurationText <> vbNullString Then
If CandidateHotel = vbNullString Then
ErrorResults.Add "مدة مبيت دون اسم فندق في البيرنق " & _
CStr(SourceRun("PairingNumber")) & _
"، صف " & CStr(DetailRow) & ". راجع بيانات البيرنق."
Exit Function
End If
If LayoverRow > 0 Then
ErrorResults.Add "يوجد أكثر من سطر مبيت في البيرنق " & _
CStr(SourceRun("PairingNumber")) & _
". يلزم دعم المبيت المتعدد قبل توزيعه."
Exit Function
End If
LayoverRow = DetailRow
HotelName = CandidateHotel
End If
End If
Next DetailRow
If FirstFlightRow = 0 Or LastFlightRow = 0 Then
ErrorResults.Add _
"تعذر قراءة قطاعات البيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
StationCode = UCase$(DE_Text( _
ws.Cells(FirstFlightRow, StartColumn + 6).Value2))
If StationCode = "JED" Then
StationCode = UCase$(DE_Text( _
ws.Cells(LastFlightRow, StartColumn + 3).Value2))
End If
If LayoverRow > 0 Then
LayoverStation = UCase$(DE_Text( _
ws.Cells(LayoverRow, StartColumn + 8).Value2))
If LayoverStation <> vbNullString Then
StationCode = LayoverStation
End If
If Not DE_ReadDurationHours( _
ws.Cells(LayoverRow, StartColumn + 9), _
LayoverHours) Then
ErrorResults.Add _
"تعذر قراءة ساعات المبيت للبيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If LayoverHours <= 0# Or LayoverStation = vbNullString Then
ErrorResults.Add _
"بيانات المبيت ناقصة أو مدته غير موجبة للبيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If LayoverHours >= 50# Then
LayoverClass = "LONG"
Else
LayoverClass = "SHORT"
End If
End If
If Not DR_CrewRequirements.Exists(StationCode) Then
ErrorResults.Add _
"المحطة " & StationCode & _
" للبيرنق " & CStr(SourceRun("PairingNumber")) & _
" غير موجودة ضمن متطلبات INFO!G:I."
Exit Function
End If
RequiredCrew = CLng( _
DR_CrewRequirements(StationCode)("CrewCount"))
TripType = CStr( _
DR_CrewRequirements(StationCode)("TripType"))
' عدد أفراد المبيت مستقل عن عدد أفراد الراوندترب للمحطة.
If LayoverRow > 0 Then RequiredCrew = 2
' استثناء عدد الطاقم اختياري ومقيد بالشهر والسنة والبيرنق.
If Not DE_ResolveCrewOverride( _
CStr(SourceRun("PairingNumber")), OperatingDate, _
RequiredCrew, ErrorResults) Then Exit Function
If Not DE_ReadClock( _
ws.Cells(FirstFlightRow, StartColumn + 4), StartClock) Then
ErrorResults.Add _
"تعذر قراءة وقت بداية البيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
If Not DE_ReadClock( _
ws.Cells(LastFlightRow, StartColumn + 7), EndClock) Then
ErrorResults.Add _
"تعذر قراءة وقت نهاية البيرنق " & _
CStr(SourceRun("PairingNumber")) & "."
Exit Function
End If
LastDayCode = UCase$(DE_Text( _
ws.Cells(LastFlightRow, StartColumn).Value2))
DayOffset = DE_DayOffset(FirstDayCode, LastDayCode)
If DayOffset = 0 Then
If EndClock < DE_CellClockValue( _
ws.Cells(LastFlightRow, StartColumn + 4)) Then
DayOffset = 1
End If
End If
StartDateTime = OperatingDate + StartClock
EndDateTime = OperatingDate + DayOffset + EndClock
If EndDateTime <= StartDateTime Then
EndDateTime = EndDateTime + 1
End If
Set RunPlan = DE_NewRecord()
RunPlan.Add "RunIndex", 0&
RunPlan.Add "PairingNumber", _
CStr(SourceRun("PairingNumber"))
' رحلات حلب ALP تُغطى حصريًا بواسطة المؤهلين لرحلات ناس،
' حتى لو كانت واقعة قبل عنوان FLY NAS في شيت PAIRING.
If StationCode = "ALP" Then
RunPlan.Add "CarrierCode", "NAS"
Else
RunPlan.Add "CarrierCode", _
UCase$(CStr(SourceRun("CarrierCode")))
End If
RunPlan.Add "OperatingDate", CDbl(OperatingDate)
RunPlan.Add "StartDateTime", CDbl(StartDateTime)
RunPlan.Add "EndDateTime", CDbl(EndDateTime)
RunPlan.Add "ReturnDayOffset", DayOffset
RunPlan.Add "StationCode", StationCode
RunPlan.Add "TripType", TripType
RunPlan.Add "IsLayover", (LayoverRow > 0)
RunPlan.Add "HotelName", HotelName
If LayoverRow > 0 Then
RunPlan.Add "LayoverEvidence", _
"مبيت؛ الفندق: " & HotelName & _
"؛ المدة بالساعات: " & Format$(LayoverHours, "0.00") & _
"؛ صف المصدر: " & CStr(LayoverRow)
Else
RunPlan.Add "LayoverEvidence", _
"راوندترب؛ لا يوجد سطر فندق ومدة مبيت في البيرنق."
End If
RunPlan.Add "LayoverHours", LayoverHours
RunPlan.Add "LayoverClass", LayoverClass
RunPlan.Add "RequiredCrew", RequiredCrew
RunPlan.Add "StartRow", StartRow
RunPlan.Add "CreditRow", CreditRow
RunPlan.Add "StartColumn", StartColumn
Set AssignedEmployees = New Collection
RunPlan.Add "AssignedEmployees", AssignedEmployees
RunPlan.Add "LeaderEmployee", vbNullString
RunPlan.Add "OfficeCount", 0&
Set DE_BuildRunPlan = RunPlan
End Function
'==========================================================
' تثبيت الارتباطات باعتبارها فترات منع
'==========================================================
Private Function DE_RegisterEvents( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim EventRecord As Object
Dim State As Object
Dim EmployeeNumber As String
Dim StartDate As Date
Dim EndDate As Date
Dim MonthStart As Date
Dim MonthEnd As Date
Dim ActiveStart As Date
Dim ActiveEnd As Date
Dim DateCursor As Date
Dim DateKey As String
Dim EventDates As Object
MonthStart = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, 1)
MonthEnd = DateSerial( _
DR_ActiveYear, DR_ActiveMonth + 1, 0)
For Each EventRecord In DR_Events
EmployeeNumber = CStr(EventRecord("EmployeeNumber"))
If Not DE_EmployeeStates.Exists(EmployeeNumber) Then
ErrorResults.Add _
"موظف الارتباط رقم " & EmployeeNumber & _
" غير موجود ضمن حالات التوزيع."
Exit Function
End If
Set State = DE_EmployeeStates(EmployeeNumber)
StartDate = CDate(CDbl(EventRecord("StartDate")))
EndDate = CDate(CDbl(EventRecord("EndDate"))) + 1
DE_AddBusyPeriod State, StartDate, EndDate, _
DE_TYPE_EVENT, False, _
CStr(EventRecord("EventName"))
ActiveStart = StartDate
If ActiveStart < MonthStart Then ActiveStart = MonthStart
ActiveEnd = EndDate - 1
If ActiveEnd > MonthEnd Then ActiveEnd = MonthEnd
If ActiveStart <= ActiveEnd Then
Set EventDates = State("EventDates")
If CLng(CDbl(ActiveEnd) - _
CDbl(ActiveStart) + 1) > _
CLng(State("LongestEventDays")) Then
State("LongestEventDays") = _
CLng(CDbl(ActiveEnd) - _
CDbl(ActiveStart) + 1)
End If
For DateCursor = ActiveStart To ActiveEnd
DateKey = CStr(CLng(CDbl(DateCursor)))
If Not EventDates.Exists(DateKey) Then
EventDates.Add DateKey, True
End If
Next DateCursor
End If
Next EventRecord
If Not DE_ApplyEventTargetAdjustments( _
ErrorResults, WarningResults) Then Exit Function
DE_RegisterEvents = True
End Function
'==========================================================
' تحديد راحة بداية الشهر من تصنيف آخر رحلة في الشهر السابق
'==========================================================
Private Function DE_GetPreviousMonthRestDays( _
ByVal EmployeeRecord As Object, _
ByRef PreviousTripType As String) As Long
Dim StationCode As String
Dim SeparatorPosition As Long
Dim Requirement As Object
PreviousTripType = vbNullString
If EmployeeRecord.Exists("PreviousLastStation") Then
StationCode = UCase$(Trim$(CStr( _
EmployeeRecord("PreviousLastStation"))))
End If
' قد تُحفظ الرحلة السابقة مثل DAC-MED أو DAC MED؛
' التصنيف يعتمد على محطة الذهاب الأساسية.
StationCode = Replace$(StationCode, "/", "-")
StationCode = Replace$(StationCode, " ", "-")
Do While InStr(1, StationCode, "--", vbBinaryCompare) > 0
StationCode = Replace$(StationCode, "--", "-")
Loop
SeparatorPosition = InStr(1, StationCode, "-", vbTextCompare)
If SeparatorPosition > 1 Then
StationCode = Left$(StationCode, SeparatorPosition - 1)
ElseIf Len(StationCode) = 6 Then
StationCode = Left$(StationCode, 3)
End If
If Not DR_CrewRequirements Is Nothing Then
If DR_CrewRequirements.Exists(StationCode) Then
Set Requirement = DR_CrewRequirements(StationCode)
PreviousTripType = UCase$(Trim$(CStr( _
Requirement("TripType"))))
End If
End If
Select Case PreviousTripType
Case "LAY"
DE_GetPreviousMonthRestDays = 3
Case "LNG", "MED"
DE_GetPreviousMonthRestDays = 2
Case "SHT"
DE_GetPreviousMonthRestDays = 1
Case Else
' إذا تعذر التعرف على التصنيف، نستخدم يومين كحل آمن
' ونسجل تنبيهًا واضحًا بدل إيقاف خطة التوزيع بالكامل.
DE_GetPreviousMonthRestDays = 2
PreviousTripType = "غير مصنفة"
If Not DE_Warnings Is Nothing Then
DE_Warnings.Add _
"تعذر تحديد تصنيف آخر رحلة للموظف " & _
CStr(EmployeeRecord("EmployeeNumber")) & _
" من المحطة [" & StationCode & _
"]. تم اعتماد يومين راحة بصورة احتياطية."
End If
End Select
End Function
'==========================================================
' صياغة كلمة يوم في وصف فترة الراحة
'==========================================================
Private Function DE_ArabicDayPhrase( _
ByVal DayCount As Long) As String
Select Case DayCount
Case 1
DE_ArabicDayPhrase = "يوم واحد"
Case 2
DE_ArabicDayPhrase = "يومين"
Case Else
DE_ArabicDayPhrase = CStr(DayCount) & " أيام"
End Select
End Function
'==========================================================
' تعديل مستهدف الموظف حسب مجموع أيام ارتباطاته في الشهر
'
' المدد المعتمدة:
' 10 أيام: خصم رحلتين.
' 15 يومًا: نصف المستهدف مع التقريب للأعلى.
' 30 يومًا: منع كامل من الرحلات والمبيت والاحتياط.
'==========================================================
Private Function DE_ApplyEventTargetAdjustments( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim State As Object
Dim EventDayCount As Long
Dim OriginalFlights As Long
Dim AdjustedFlights As Long
Dim OriginalLayovers As Long
Dim AdjustedLayovers As Long
Dim DaysInMonth As Long
Dim CarryoverTarget As Long
DaysInMonth = GregDaysInMonth( _
DR_ActiveYear, DR_ActiveMonth)
For Each EmployeeKey In DE_EmployeeStates.Keys
Set State = DE_EmployeeStates(EmployeeKey)
EventDayCount = CLng(State("LongestEventDays"))
OriginalFlights = CLng(State("OriginalFlightTarget"))
OriginalLayovers = CLng(State("OriginalLayoverTarget"))
AdjustedFlights = OriginalFlights
CarryoverTarget = CLng(State("CarryoverTarget"))
State("EventDayCount") = State("EventDates").Count
State("TargetAdjustmentReason") = vbNullString
State("IsNoFlightMonth") = False
Select Case EventDayCount
Case 0 To 9
' يمنع الارتباط أيامه فقط، ولا يخفض المستهدف.
Case 10
AdjustedFlights = OriginalFlights - 2
If AdjustedFlights < 0 Then AdjustedFlights = 0
State("TargetAdjustmentReason") = _
"ارتباط 10 أيام: خصم رحلتين"
Case 15
AdjustedFlights = (OriginalFlights + 1) \ 2
State("TargetAdjustmentReason") = _
"ارتباط 15 يومًا: نصف المستهدف"
Case Is >= 30
AdjustedFlights = 0
State("IsNoFlightMonth") = True
State("TargetAdjustmentReason") = _
"ارتباط 30 يومًا: منع شهري كامل"
Case Else
WarningResults.Add _
"مدة ارتباط الموظف " & _
CStr(State("EmployeeNumber")) & _
" داخل الشهر هي " & _
CStr(EventDayCount) & _
" يومًا، وهي ليست من المدد المعتمدة " & _
"10 أو 15 أو 30 يومًا؛ مُنعت أيام " & _
"الارتباط دون تخفيض المستهدف."
End Select
If OriginalFlights > 0 _
And OriginalLayovers > 0 _
And AdjustedFlights > 0 Then
AdjustedLayovers = _
((OriginalLayovers * AdjustedFlights) + _
OriginalFlights - 1) \ OriginalFlights
Else
AdjustedLayovers = 0
End If
If AdjustedLayovers > AdjustedFlights Then
AdjustedLayovers = AdjustedFlights
End If
' الإداري والموقوف وموظف الاستاندباي لا يدخلون في
' التوزيع الآلي ولا الاحتياط. رحلات الإداري تُثبت فقط
' من OFFICE_DATA، وموظف SB يُسجل له تناوبه الشهري فقط.
If CBool(State("IsOffice")) _
Or CBool(State("IsHold")) _
Or CBool(State("IsStandby")) Then
AdjustedFlights = 0
AdjustedLayovers = 0
CarryoverTarget = 0
End If
State("NormalFlightTarget") = AdjustedFlights
State("FlightTarget") = _
AdjustedFlights + CarryoverTarget
State("LayoverTarget") = AdjustedLayovers
If AdjustedLayovers > 0 Then
State("LongLayoverTarget") = 1
State("ShortLayoverTarget") = _
AdjustedLayovers - 1
Else
State("LongLayoverTarget") = 0
State("ShortLayoverTarget") = 0
End If
DE_SetEmployeeCarrierTargets State
Next EmployeeKey
DE_ApplyEventTargetAdjustments = True
End Function
'==========================================================
' تقسيم مستهدف الموظف بين السعودية والناقل المتخصص
'==========================================================
Private Sub DE_SetEmployeeCarrierTargets( _
ByVal State As Object)
Dim TotalTarget As Long
Dim SaudiaTarget As Long
Dim SpecialTarget As Long
Dim SpecialCarrier As String
Dim SaudiaDemand As Long
Dim SpecialDemand As Long
' يقسم المستهدف العادي أولًا، ثم تضاف مطالبات الشهر
' السابق إلى ناقلها المحدد دون تغيير توازن الرحلات العادية.
TotalTarget = CLng(State("NormalFlightTarget"))
Select Case UCase$(CStr(State("CarrierProfile")))
Case "SAUDIA_NAS"
SpecialCarrier = "NAS"
Case "SAUDIA_ADEAL"
SpecialCarrier = "ADEAL"
Case Else
SpecialCarrier = vbNullString
End Select
If SpecialCarrier = vbNullString Then
SaudiaTarget = TotalTarget
SpecialTarget = 0
Else
SaudiaTarget = TotalTarget \ 2
SpecialTarget = TotalTarget \ 2
If TotalTarget Mod 2 <> 0 Then
SaudiaDemand = DE_CarrierRunCount("SAUDIA")
SpecialDemand = DE_CarrierRunCount(SpecialCarrier)
If SaudiaDemand > SpecialDemand Then
SaudiaTarget = SaudiaTarget + 1
Else
SpecialTarget = SpecialTarget + 1
End If
End If
End If
State("SaudiaTarget") = SaudiaTarget
State("SpecialCarrierTarget") = SpecialTarget
State("SpecialCarrierCode") = SpecialCarrier
State("SaudiaTarget") = _
CLng(State("SaudiaTarget")) + _
CLng(State("CarryoverSaudiaTarget"))
State("SpecialCarrierTarget") = _
CLng(State("SpecialCarrierTarget")) + _
CLng(State("CarryoverSpecialTarget"))
End Sub
Private Function DE_CarrierRunCount( _
ByVal CarrierCode As String) As Long
Dim RunPlan As Object
For Each RunPlan In DE_RunPlans
If StrComp(CStr(RunPlan("CarrierCode")), _
CarrierCode, vbTextCompare) = 0 Then
DE_CarrierRunCount = _
DE_CarrierRunCount + 1
End If
Next RunPlan
End Function
'==========================================================
' إنشاء تناوب SB-1 / SB-2 / SB-3 طوال الشهر
'==========================================================
Private Function DE_RegisterStandby( _
ByRef ErrorResults As Collection) As Boolean
Dim EmployeeKey As Variant
Dim State As Object
Dim SBGroup As String
Dim GroupNumber As Long
Dim DayNumber As Long
Dim DaysInMonth As Long
Dim DutyDate As Date
DaysInMonth = GregDaysInMonth( _
DR_ActiveYear, DR_ActiveMonth)
For Each EmployeeKey In DR_SBByEmployee.Keys
If Not DE_EmployeeStates.Exists(CStr(EmployeeKey)) Then
ErrorResults.Add _
"موظف الاستاندباي رقم " & CStr(EmployeeKey) & _
" غير موجود ضمن حالات التوزيع."
Exit Function
End If
Set State = DE_EmployeeStates(CStr(EmployeeKey))
State("IsStandby") = True
SBGroup = UCase$(CStr(DR_SBByEmployee(EmployeeKey)))
Select Case SBGroup
Case "SB-1": GroupNumber = 1
Case "SB-2": GroupNumber = 2
Case "SB-3": GroupNumber = 3
Case Else
ErrorResults.Add _
"رمز الاستاندباي " & SBGroup & _
" غير صحيح للموظف " & CStr(EmployeeKey) & "."
Exit Function
End Select
For DayNumber = GroupNumber To DaysInMonth Step 3
DutyDate = DateSerial( _
DR_ActiveYear, DR_ActiveMonth, DayNumber)
DE_AddAssignment _
State, Nothing, DE_TYPE_SB, SBGroup, _
DutyDate, DutyDate + 1, False, False
Next DayNumber
Next EmployeeKey
DE_RegisterStandby = True
End Function
'==========================================================
' تثبيت رحلات الإداريين قبل التوزيع الآلي
'==========================================================
Private Function DE_RegisterOfficeFlights( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim OfficeRecord As Object
Dim RunPlan As Object
Dim State As Object
Dim EmployeeNumber As String
Dim PairingNumber As String
Dim FlightDate As Date
Dim IsLeader As Boolean
Dim GroupCode As String
Dim ExistingLeader As String
Dim ExistingLeaderState As Object
Dim ConflictDetails As String
For Each OfficeRecord In DR_OfficeFlights
EmployeeNumber = CStr(OfficeRecord("EmployeeNumber"))
PairingNumber = CStr(OfficeRecord("PairingNumber"))
FlightDate = CDate(CDbl(OfficeRecord("FlightDate")))
If Not DE_EmployeeStates.Exists(EmployeeNumber) Then
ErrorResults.Add _
"الإداري رقم " & EmployeeNumber & _
" غير موجود ضمن حالات التوزيع."
Exit Function
End If
Set RunPlan = DE_FindRun(PairingNumber, FlightDate)
If RunPlan Is Nothing Then
ErrorResults.Add _
"تعذر إيجاد تشغيل البيرنق " & PairingNumber & _
" بتاريخ " & Format$(FlightDate, "dd/mm/yyyy") & _
" الخاص بالإداري " & EmployeeNumber & "."
Exit Function
End If
Set State = DE_EmployeeStates(EmployeeNumber)
If CBool(State("IsNoFlightMonth")) Then
ErrorResults.Add _
"الإداري رقم " & EmployeeNumber & _
" لديه ارتباط مدته 30 يومًا، ولا يجوز " & _
"تثبيت رحلة له خلال الشهر."
Exit Function
End If
If Not DE_EmployeeCanCoverCarrier( _
CStr(State("CarrierProfile")), _
CStr(RunPlan("CarrierCode"))) Then
ErrorResults.Add _
"الإداري رقم " & EmployeeNumber & _
" مؤهل بصفة " & CStr(State("CarrierProfile")) & _
"، ولا يستطيع تغطية البيرنق " & PairingNumber & _
" التابع للناقل " & _
CStr(RunPlan("CarrierCode")) & "."
Exit Function
End If
ConflictDetails = vbNullString
If Not DE_IsAvailable( _
State, CDate(RunPlan("StartDateTime")), _
CDate(RunPlan("EndDateTime")), _
ConflictDetails) Then
ErrorResults.Add _
"رحلة الإداري رقم " & EmployeeNumber & _
"، البيرنق " & PairingNumber & _
"، بتاريخ " & _
Format$(FlightDate, "dd/mm/yyyy") & _
" تتعارض مع فترة مسجلة مسبقًا." & _
vbCrLf & _
"الفترة الجديدة: " & _
Format$(CDate(RunPlan("StartDateTime")), _
"dd/mm/yyyy hh:mm") & _
" إلى " & _
Format$(CDate(RunPlan("EndDateTime")), _
"dd/mm/yyyy hh:mm") & _
vbCrLf & ConflictDetails
Exit Function
End If
GroupCode = CStr(State("GroupCode"))
ExistingLeader = CStr(RunPlan("LeaderEmployee"))
IsLeader = False
Select Case GroupCode
Case "SSS", "SST"
If ExistingLeader <> vbNullString Then
Set ExistingLeaderState = _
DE_EmployeeStates(ExistingLeader)
If CStr(ExistingLeaderState("GroupCode")) = "STS" Then
DE_DemoteLeader _
ExistingLeaderState, RunPlan
ExistingLeader = vbNullString
End If
End If
IsLeader = True
Case "STS"
IsLeader = (ExistingLeader = vbNullString)
End Select
If IsLeader Then
If ExistingLeader <> vbNullString Then
WarningResults.Add _
"البيرنق " & PairingNumber & _
" بتاريخ " & Format$(FlightDate, "dd/mm/yyyy") & _
" يحتوي أكثر من قائد إداري وفق الاختيار المعتمد."
Else
RunPlan("LeaderEmployee") = EmployeeNumber
End If
End If
DE_AddAssignment _
State, RunPlan, DE_TYPE_OFFICE, PairingNumber, _
CDate(RunPlan("StartDateTime")), _
CDate(RunPlan("EndDateTime")), _
CBool(RunPlan("IsLayover")), IsLeader
RunPlan("OfficeCount") = _
CLng(RunPlan("OfficeCount")) + 1
If RunPlan("AssignedEmployees").Count > _
CLng(RunPlan("RequiredCrew")) Then
WarningResults.Add _
"عدد الإداريين المختارين على البيرنق " & _
PairingNumber & " تجاوز عدد الطاقم المطلوب."
End If
Next OfficeRecord
DE_RegisterOfficeFlights = True
End Function
Private Sub DE_DemoteLeader( _
ByVal State As Object, _
ByVal RunPlan As Object)
Dim Assignment As Object
For Each Assignment In State("Assignments")
If CLng(Assignment("RunIndex")) = _
CLng(RunPlan("RunIndex")) _
And CBool(Assignment("IsLeader")) Then
Assignment("IsLeader") = False
If CLng(State("LeaderCount")) > 0 Then
State("LeaderCount") = _
CLng(State("LeaderCount")) - 1
End If
Exit For
End If
Next Assignment
RunPlan("LeaderEmployee") = vbNullString
End Sub
'==========================================================
' توزيع الرحلات المطالب بها من الشهر السابق
'
' كل سجل في CARRYOVER_FLIGHTS يمثل رحلة إضافية واحدة فوق
' المستهدف العادي. تُختار له رحلة فعلية تطابق الناقل ونوع
' الرحلة، مع المحافظة على الأهلية والتعارض وراحة 24 ساعة.
' لا تدخل رحلة المبيت المطالب بها ضمن حصة المبيت العادية.
'==========================================================
Private Function DE_DistributeCarryoverFlights( _
ByRef ErrorResults As Collection, _
ByRef WarningResults As Collection) As Boolean
Dim CarryoverRecord As Object
Dim RunPlan As Object
Dim State As Object
Dim EmployeeNumber As String
Dim IsLeader As Boolean
For Each CarryoverRecord In DR_CarryoverFlights
EmployeeNumber = CStr( _
CarryoverRecord("EmployeeNumber"))
If Not DE_EmployeeStates.Exists(EmployeeNumber) Then
ErrorResults.Add _
"موظف الرحلة المطالب بها رقم " & _
EmployeeNumber & _
" غير موجود ضمن حالات التوزيع."
Exit Function
End If
Set State = DE_EmployeeStates(EmployeeNumber)
If CBool(State("IsHold")) _
Or CBool(State("IsOffice")) _
Or CBool(State("IsStandby")) _
Or CBool(State("IsNoFlightMonth")) Then
ErrorResults.Add _
"تعذر توزيع الرحلة المطالب بها للموظف " & _
EmployeeNumber & "؛ حالته الحالية لا تسمح " & _
"بدخوله في التوزيع الآلي."
Exit Function
End If
Set RunPlan = DE_SelectCarryoverRun( _
State, CarryoverRecord, IsLeader)
If RunPlan Is Nothing Then
ErrorResults.Add _
"تعذر تغطية الرحلة المطالب بها للموظف " & _
EmployeeNumber & " - " & _
CStr(State("EmployeeName")) & _
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: الجزء الثاني بدأ من الموضع الصحيح، لكنه **انقطع أيضًا** داخل `DE_DistributeReserveDays`. Auto Claude: حدّد آخر سطر كامل وصل الآن، واطلب من المستخدم أن يكمل من عدة أسطر قبله فقط، دون بدء تحليل الكود حتى تصل نهاية الموديول.
### Auto Claude (Claude Sonnet 5.5)
وصل الجزء الثاني من الموضع الصحيح، وهو موصول بالأول: القيمتان `72#` و`48#` ظهرتا كاملتين، وبعدهما بدأت `DistributionEngine_BuildPlan`.
**آخر ما وصل:** انقطع الجزء داخل هذا الشرط:
```vb
CurrentStep = "توزيع أيام الاحتياط"
If Not DE_DistributeReserveDays( _
ErrorResults, WarningResults) Then
ValidationPassed = False
```
السطر الأخير الكامل هو `ValidationPassed = False`، وقد يكون ما بعده سطر `End If` ناقصًا. وما وصلني يكفي لفهم بداية البناء فقط، أما الإجراءات الفعلية (المبيت، الراوندترب، الإصلاح) فلم تصل بعد، فلن أحلل شيئًا الآن.
**المطلوب:** أرسل الجزء الثالث، وابدأه من نحو 5 أسطر قبل `CurrentStep = "توزيع أيام الاحتياط"` (أي من `If Not DE_RegisterOfficeFlights...`)، وكمّل حتى النهاية.
**نصيحة:** لا تنتظر أن تنقطع الرسائل؛ قسّم الباقي من البداية إلى رسائل أقصر (نحو 150 سطرًا لكل رسالة)، وابدأ كل واحدة بـ`--- جزء 3 ---` وهكذا، واختم الأخيرة بـ`--- نهاية الموديول ---`.
### Participant
اين توقف الكود
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: أجب المستخدم مباشرة وباختصار شديد: اذكر **آخر سطر كامل وصل حرفيًا**، ثم السطر الذي يُفضّل أن يبدأ منه الإرسال التالي حتى نضمن الاتصال.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
آخر سطر كامل وصل هو:
```vb
ValidationPassed = False
```
ولضمان الاتصال، ابدأ الإرسال القادم من هذا السطر:
```vb
CurrentStep = "توزيع أيام الاحتياط"
```
ثم أكمل من بعده.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: ابدأ الجزء القادم من `CurrentStep = "توزيع أيام الاحتياط"` ثم أكمل الكود من هناك.
**Agreed**
- آخر سطر كامل وصل هو `ValidationPassed = False`.
- إعادة بضعة أسطر مكررة لا تسبب مشكلة.
- استمر حتى نهاية الموديول.
### Participant
على الوضع هذا بنتاخر كثير لانه ياخذ جزء جزء وهذا جدأ سيئ ارد طريقه لتحميل الكود كاملا هنا .. كيف يكون ذلك
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Auto Claude: نحتاج حلًا عمليًا نهائيًا بدل التقسيم؛ بما أن `.bas` ظهرت عليه علامة المنع، اشرح للمستخدم **طريقة واحدة مضمونة لتحويل/حفظ الكود في ملف يقبل الرفع هنا** مع الحفاظ على الكود كاملًا، خطوة بخطوة وبأقل تعقيد.
### Auto Claude (Claude Sonnet 5.5)
الطريقة المضمونة: **حوّل الكود إلى ملف `.txt` وارفعه**، لأن علامة المنع ظهرت على `.bas` فقط على الأغلب بسبب نوع الملف، وأنا ما أقدر أؤكد أن واجهة هذه الغرفة تقبل أي مرفق أصلًا.
**الخطوات:**
1. صدّر الموديول: في VBA كليك يمين على الموديول ثم **Export File** واحفظه على سطح المكتب.
2. اضغط على الملف مرة واحدة، ثم **F2** وغيّر الامتداد من `.bas` إلى `.txt`، ووافق على التحذير.
3. اسحبه إلى مربع المحادثة أو استخدم أيقونة المرفق 📎 (إن وُجدت).
**إذا ظهر المنع أيضًا مع `.txt`:** فالغرفة لا تقبل مرفقات، وعندها لا يبقى إلا النسخ واللصق.
**لتقليل التأخير في النسخ واللصق:**
- افتح الملف بالمفكرة، واضغط **Ctrl+A** ثم **Ctrl+C**.
- الصق كل 300–400 سطر في رسالة، وأرسل الرسائل متتالية بدون انتظار ردنا، مع ترقيمها `1/4` و`2/4`.
وبما أنك أرسلت إلى الآن حتى `DE_DistributeReserveDays`، فالباقي هو كل ما بعد هذا الموضع.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: راجع اقتراح تغيير امتداد `.bas` إلى `.txt` من زاوية **الحفاظ على العربية والترميز**؛ هل إعادة التسمية وحدها آمنة، أم الأفضل فتحه وحفظ نسخة TXT بترميز محدد قبل رفعه؟ أعط الطريقة الأقل مخاطرة للمستخدم.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
الأفضل **لا تغيّر امتداد `.bas` فقط**؛ لأننا رأينا بالفعل أن التعليقات العربية وصلت مشوهة. نريد ملفًا نصيًا جديدًا بترميز يحفظ العربية.
اعمل التالي:
1. افتح **المفكرة Notepad**.
2. من VBA افتح الموديول المطلوب واضغط داخل الكود:
**Ctrl+A** ثم **Ctrl+C**.
3. الصقه في المفكرة بـ **Ctrl+V**.
4. من المفكرة اختر **File → Save As**.
5. سمّه مثلًا:
`R19.txt`
6. عند **Encoding / الترميز** اختر **UTF-8**.
7. اضغط **Save**.
8. الآن اسحب ملف `R19.txt` نفسه إلى هذه المحادثة وأرسله.
هذه أفضل من مجرد إعادة تسمية `.bas` إلى `.txt`؛ لأنها تعطينا **الكود كاملًا والتعليقات العربية سليمة** في ملف واحد.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: أفضل طريقة هي نسخ الموديول كاملًا من VBA إلى المفكرة وحفظه باسم `R19.txt` بترميز **UTF-8** ثم رفع الملف هنا.
**Agreed**
- استخدم `Ctrl+A` ثم `Ctrl+C` داخل الموديول، والصقه في Notepad.
- احفظه كملف `.txt` واختر **UTF-8**.
- ارفع ملف `R19.txt` كاملًا بدل تقسيم الكود على رسائل.
**Why**
- بهذه الطريقة يصل الكود كاملًا في ملف واحد.
- UTF-8 يحافظ على التعليقات العربية بدل ظهورها مشوهة.
### Participant
اذا رفعته في هذه المحادثه تنفتح لي موقع ويب فيه الكود
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: سحب ملف `.txt` يبدو أنه يُفتح في المتصفح بدل أن يُرفق بالمحادثة. Auto Claude: أعط المستخدم طريقة رفع الملف **من داخل واجهة ChatGPT نفسها** دون السحب والإفلات، بخطوات واضحة ومختصرة.
### Auto Claude (Claude Sonnet 5.5)
الظاهر أن المتصفح فتح الملف بدل إرفاقه، لأن الإسقاط وقع خارج مربع الكتابة، أو لأن هذه الغرفة لا تدعم المرفقات أصلًا. وما أعرف شكل واجهتها بالضبط، فهذا تخمين.
**جرّب بدون سحب وإفلات:**
1. اضغط داخل مربع الكتابة نفسه.
2. ابحث بجانبه عن **+** أو أيقونة **📎**، واضغطها.
3. اختر **Add photos & files** (أو ما يشبهها)، ثم حدد `R19.txt` من سطح المكتب.
4. انتظر ظهور اسم الملف في المربع، ثم أرسل.
**إذا ما وجدت أي أيقونة بجانب المربع:** فالمرفقات غير متاحة في هذه الغرفة، ولا يبقى إلا النسخ واللصق.
**أسرع طريقة للنسخ واللصق (بدون انتظارنا):**
- افتح `R19.txt` في المفكرة، وانسخ **من سطر `CurrentStep = "توزيع أيام الاحتياط"` إلى النهاية** فقط، لأن ما قبله وصلنا.
- الصق كل نحو 150 سطرًا في رسالة، وأرسل الرسائل متتالية، مرقمة `3/N` و`4/N`.
- اختم الأخيرة بـ`--- نهاية الموديول ---`.
وقل لنا وش تشوف بجانب مربع الكتابة، حتى أعطيك الخطوة المناسبة لواجهتك بدل التخمين.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: هناك احتمال أن المشكلة ليست دعم المرفقات بل **طريقة فتح الملف من Windows/المتصفح**؛ أعط المستخدم اختبارًا واحدًا بسيطًا يحدد هل زر `+` في هذه المحادثة يسمح باختيار `R19.txt` وإرفاقه فعلًا.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
خلنا نجرب **اختبارًا واحدًا فقط** بدون سحب الملف:
1. انظر بجانب مربع الكتابة في هذه المحادثة.
2. اضغط علامة **`+`** الموجودة بجانب مربع الرسالة.
3. إذا ظهر لك خيار **إضافة صور وملفات / Add photos & files** اضغط عليه.
4. اختر ملف **`R19.txt`** من جهازك.
إذا ظهر **اسم `R19.txt` داخل مربع الرسالة كمرفق** قبل الإرسال، فالأمور تمام — اضغط إرسال.
إذا لم يظهر خيار إضافة الملفات عند الضغط على `+`، قل لي **ما الخيارات التي ظهرت لك بالضبط** وسأعطيك الخطوة المناسبة مباشرة.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
**Conclusion**: نحتاج نتيجة اختبار زر `+` قبل تجربة أي طريقة أخرى.
**Agreed**
- اضغط `+` بجانب مربع الرسالة واختر **إضافة صور وملفات** إن ظهر.
- اختر `R19.txt` وتأكد هل يظهر اسمه كمرفق داخل الرسالة.
**What would change it**
- إذا لم يظهر خيار الملفات أو فتح الملف كصفحة ويب، أخبرنا بما ظهر تحديدًا لننتقل للطريقة المناسبة.
### Participant
لا يوجد + بجانب مكان ارسال الرسائل
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: واجهة المستخدم لا تعرض زر `+`، لذلك نحتاج معرفة هل توجد **أيقونة مشبك/ملف أو زر آخر للإرفاق** بدل افتراض أن المرفقات غير مدعومة. Auto Claude: أعطه طريقة سريعة لتحديد زر الإرفاق في واجهته الحالية.
### Auto Claude (Claude Sonnet 5.5)
بما أنه ما في زر إرفاق ظاهر، فالأرجح أن هذه الغرفة **ما تدعم المرفقات**، وكون الملف فُتح كصفحة ويب لما أسقطته يدعم هذا. لكنه استنتاج وليس تأكيدًا، فما أعرف واجهتك.
**فحص سريع (نصف دقيقة):**
- مرّر الماوس على الأيقونات بجانب مربع الكتابة (يمين ويسار وتحته) وشوف هل فيها مشبك 📎 أو أيقونة ملف.
- جرّب **Ctrl+V** بعد نسخ الملف نفسه من المجلد (ليس نصه). إذا ظهر كمرفق فالرفع مدعوم.
- إذا ما ظهر شيء، اعتبر الرفع غير متاح.
**الحل العملي بدل الانتظار:** النسخ واللصق، لكن بدون تقسيم بطيء:
1. افتح الموديول في VBA واضغط **Ctrl+A** ثم **Ctrl+C**.
2. الصق في رسالة واحدة. إذا رفضتها الغرفة لطولها، قسّمها إلى 3 أو 4 رسائل كبيرة (نحو 400 سطر).
3. أرسلها **متتالية دون انتظار ردنا**، مرقمة `1/4` إلى `4/4`، واختم بـ`--- نهاية الموديول ---`.
أنت أرسلت لنا فعلًا ما قبل `CurrentStep = "توزيع أيام الاحتياط"`، فابدأ من هذا السطر فقط واكمل للنهاية. هذا يوفر نصف العمل.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
Chatty GPT 5.6: بدل التخمين حول دعم المرفقات، هل توجد طريقة **أخرى داخل ChatGPT على الكمبيوتر** للوصول لاختيار الملفات عندما لا يظهر `+` أو المشبك؟ أعط خيارًا واحدًا فقط يمكن للمستخدم تجربته فورًا.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
نعم، يوجد خيار آخر أسهل ولا يعتمد على زر `+`:
من القائمة الجانبية اليسرى في ChatGPT افتح **Library / المكتبة**، ثم اضغط **Upload / رفع** واختر ملف `R19.txt`. رفع ملفات TXT مدعوم رسميًا، والمكتبة تسمح برفع الملف مباشرة من الكمبيوتر.
جرّب هذه الخطوة فقط الآن. إذا وجدت **Library / المكتبة** ورفعت الملف بنجاح، أخبرني وسأصل إليه من هنا بدل تقطيع الكود.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: اقتُرح رفع `R19.txt` عبر **Library / المكتبة** بدل مربع المحادثة. Auto Claude: تحقّق من صحة هذا المسار، وهل الملف المرفوع للمكتبة يصبح قابلًا للوصول من هذه المحادثة مباشرة دون خطوة إضافية؟
### Auto Claude (Claude Sonnet 5.5)
لا أستطيع تأكيد هذا المسار، ولا أعتمد عليه. Chatty GPT 5.6 قال إن رفع TXT إلى المكتبة مدعوم رسميًا وإن الملف سيصل إلينا، لكنه لم يذكر مصدرًا، ولم أتحقق منه بنفسي. وأنا ضعيف التحقق هنا لسببين.
1. **رفع الملف إلى مكتبة حسابك لا يعني أنه يصلني.** هذه الغرفة تجمع عدة نماذج، وأنا لا أرى إلا الرسائل التي تصلني في المحادثة. لا أعرف إن كانت مكتبة ChatGPT تظهر لي أصلًا، والأرجح أنها لا تظهر. وإذا كان ذلك صحيحًا فلن أصل إلى الملف حتى لو رفعه المستخدم بنجاح.
2. **قد تكون الرسالة التالية "رفعت الملف" ثم لا يصل شيء**، فيضيع وقت المستخدم مرة أخرى.
لذلك أقترح اختبارًا رخيصًا قبل أي رفع: يرفع المستخدم الملف ثم يكتب رسالة قصيرة، وإذا لم نستطع ذكر أول سطر فيه وآخر سطر فيه، فالمسار غير صالح وينتقل فورًا إلى اللصق.
ومع هذا يبقى اللصق المباشر هو الطريق المضمون. يلصق المستخدم من `CurrentStep = "توزيع أيام الاحتياط"` إلى النهاية في رسائل كبيرة متتالية.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
يوجد تعارض واقعي حول ما إذا كان رفع الملف إلى **Library** يجعله متاحًا لهذه المحادثة. Chatty GPT 5.6: تحقّق عبر الويب من توثيق OpenAI الرسمي فقط، وحدد بدقة هل يمكن رفع `R19.txt` للمكتبة ثم استخدامه في هذه المحادثة، وما الخطوة المطلوبة إن وجدت.
### Chatty GPT 5.6 (ChatGPT GPT-5.6)
تحققت الآن من **توثيق OpenAI الرسمي**، وتصحيح Auto Claude مهم جزئيًا: **رفع الملف إلى Library وحده لا يعني أنه أُضيف تلقائيًا لهذه المحادثة**.
OpenAI توضح أن Library تسمح برفع الملفات وحفظها وإعادة استخدامها، لكن لإضافة ملف محفوظ إلى محادثة توجد خطوة مستقلة: من قائمة الكتابة تختار **Add from library** ثم الملف.
لكن توجد نقطة مهمة جدًا لحالتنا: توثيق OpenAI الأحدث يقول أيضًا إن ChatGPT يستطيع البحث في ملفات Library تلقائيًا إذا كانت ميزة **Library search** مفعّلة، ويمكن للمستخدم أن يسأل عن ملف محفوظ لديه.
لذلك أسهل اختبار عندك، خصوصًا لأن زر `+` غير موجود:
**ارفع `R19.txt` إلى Library، ثم ارجع لهذه المحادثة واكتب فقط:**
> رفعت ملف R19.txt في المكتبة، اقرأه.
وأنا سأحاول الوصول إليه من المكتبة مباشرة. إذا ظهر لي، انتهت مشكلة تقطيع الكود نهائيًا. وإذا لم يظهر، نعرف يقينًا أن هذه المحادثة تحتاج ربط الملف بطريقة أخرى.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
النقطة الجديدة: Library قد تتيح الوصول للملف عبر البحث، لكن ذلك يعتمد على توفر **Library search** في هذه الجلسة. Auto Claude: بناءً على هذا التحقق، أعط المستخدم الآن خطوة واحدة فقط لتنفيذها، دون بدائل أو تقسيم للكود.
### Auto Claude (Claude Sonnet 5.5)
الخطوة الوحيدة الآن: **الصق الكود مباشرة في رسالة**، بدل تجربة المكتبة.
لماذا أتراجع عن المكتبة: Chatty GPT 5.6 قال إنه تحقق من توثيق OpenAI، لكنه لم يضع رابطًا أستطيع فحصه. وحتى لو كان الوصف صحيحًا لواجهة ChatGPT نفسها، فهذه الغرفة تجمع أكثر من نموذج. لا أرى أنا إلا الرسائل المكتوبة فيها، ولا شيء يثبت أن مكتبة حسابك تصل إليّ. فقد تضيّع وقتك في رفع ملف لا أراه.
الجزء الأول وصل كاملًا حتى `DE_DistributeReserveDays`. المطلوب الآن:
1. افتح الموديول في VBA، واضغط **Ctrl+A** ثم **Ctrl+C**.
2. الصق في رسالة واحدة ابتداءً من السطر `CurrentStep = "توزيع أيام الاحتياط"` وحتى نهاية الموديول.
3. إذا قُطعت الرسالة، قل لنا فقط آخر كلمة ظهرت لك، ونكمل من هناك.
وإن أمكن أرسل بعدها تقرير آخر تشغيل. التقرير أقصر من الكود، ويفيدنا في فهم سبب بقاء 135 ناقصًا.
### Chatty GPT GPT-5.6 (ChatGPT GPT-5.6) · Moderator
_This AI did not answer_
---
— https://claudetuner.com/c/nUYJAP39cuNx9ure3vJjqN (Claude Tuner)