نجوم المشاركات

أخواني وأساتذتي ومعلمينا ( دون استثناء ) الكثير من المواضيع التي قد تكون تطرقت الى هذا الموضوع ولكن بطرق وأشكال مختلفة . اليوم وفقط في أوفيسنا / آكسيس ، سأقدم لكم نظام كامل متكامل لإدارة الطابور والدور الذي يمكن استخدامه في أي منشئة تجارية تتعامل بهذا النظام . من المعروف أننا عندما ندخل مركز للصرافة على سبيل المثال ، فإن العميل يحصل على رقم دور مطبوع على شكل تذكرة يحتفظ بها لحين تفرغ موظف لتلبية طلبه وخدمته . وعند انتظارك كعميل لحين وصول الدور لك فإنك تراقب شاشة الدور لمعرفة أين وصل الدور لأي تذكرة . وطبعاً ما يميز هذا النظام أنك في حين لم تكن متابعاً لشاشة العرض فإن النظام الصوتي كفيل بتنبيهك أين وصل الدور ولأي شباك موظف . إلى هنا وكل هذا متاح لك اليوم مع نظام مراقبة الطابور والدور الجديد . وسنسير بشرح المكونات تسلسلاً وشرحاً وافياً ( دون الإطالة .. ) أولاً :- واجهة حجز الدور الذي سيبدأ منها العميل بأخذ دور له ، وهي ذات واجهة بسيطة فقط زر واحد ينقره العميل للحصول على رقم دوره . مرفق تالياً صورة الواجهة ، والتي تدعم بالطبع شاشة اللمس . أي أن ما على العميل فقط هو النقر على الزر "احصل على رقم دور جديد" . ثانياً :- وبعد أن حصل العميل على دوره ، سيراقب دوره في قاعة الإنتظار على شاشة عرض الأدور ، والتي بدورها ستخبر العميل الى أي شباك موظف عليه التوجه حين يحين دوره ، وطبعاً لإرضاء الرغبات قمت بإضافة ميزة الناطق الصوتي ( عربي - انجليزي "اللغة الإفتراضية" ) . أي أنه عليك - كمستخدم أو مصمم - لاحقاً تفعيل اللغة العربية الصوتية (Text-to-speech) . وهنا نقطة مهمة يجب أن نمر عليها سريعاً كي تتوضح لك عزيزي القارئ كيف يمكن تفعيل القارئ الصوتي العربي للنصوص . لذا هذا الفيديو يوضح الخطوات الأولى لإضافة اللغة العربية الصوتية إلى ويندوز 10 . النقطة المزعجة من مايكروسوفت أنه وللأسف لا يتم فعلاً إضافة هذه التثبيتات الى مكانها الصحيح في محرر الريجستري . لذا علينا فعل ذلك بالطريقة اليدوية لضمان تشغيل القارئ الصوتي العربي . لذا ولمحة سريعة سنتطرق للموضوع بشكل مختصر :- بعد الذهاب إلى محرر الريجستري + R اكتب كلمة regedit اذهب الى المسار التالي : Computer\HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Speech_OneCore\Voices\Tokens قم بتصدير هذا المفتاح كاملاً الى سطح المكتب بأي اسم تريده . افتح ملف الريجستري هذا باستخدام المفكرة Notepad . قم بإزالة الجزء "_OneCore" من جميع المسارات الموجودة أمامك . احفظ الملف ، وافتحه واختر Yes - نعم من الرسالة التي ستظهر لك مرتين ( على ما أعتقد ) . مبروك عليك تفعيل الناطق العربي . لك حرية الإختيار بتفعيل اللغة العربية أو لا ، ويمكنك الإنتقال لباقي الشرح . تابع معي :- الآن جاء دور الموظفين الذي سيكون لهم جميعهم نموذج واحد بنفس الأكواد بدون أي فرق لا في الشكل ولا في طريقة العمل ، انظر الصورة لاستكمال الشرح :- صورة لواجهة الموظف ( الشباك 1 ) والأمر نفسه لباقي الموظفين . ماذا يمكن للموظف أن يفعل هنا ؟ فقط النقر على الزر الذي سيكون مفعلاً عند وجود عملاء في الإنتظار ( استدعاء التالي & عدد العملاء الذين في الإنتظار ) كما في الصورة التالية :- فقط بعد النقر سيتم استدعاء العميل الأول في الانتظار ( حسب وقت الحجز طبعاً ) الى الشباك 1 :- طبعاً من المزايا المتاحة للموظف ، تحويل عميله الى موظف آخر ( ذو اختصاص على سبيل المثال ) ... إلخ . أو أن يطلب استراحة ( عند عدم انشغاله في عميل ) بأن يكون غير متاح في هذه الفترة لتلقي العملاء .... إلخ . وأيضاً بدء وانهاء خدمة العميل . وطبعاً الأمر ينطبق على جميع الموظفين . ثالثاً :- لوحة عرض العملاء في الإنتظار ، ذات واجهة بسيطة ومريحة كالتالي :- ليس بها أي تعقيد أو أمور تتطلب اعدادات أو ضبط خاص . رابعاً :- شاشة تحكم المدير ، وبهذه الواجهة سنشرحها في نقاط .. الجهة اليمنى تمثل إحصائيات واضحة للمدير عن تفاصيل حركة الدور ... الأزرار في أسفل يمين الشاشة تمثل :- • زر مخصص لتفعيل / تعطيل الناطق الصوتي لرقم الدور . • زر تحديث يدوي = تحديث للتفاصيل الظاهرة للشاشة بشكل يدوي . • زر تعيين القيمة التلقائية للتحديث = عند النقر عليه سيتم اظهار قائمة بسيطة تمثل رقم الدقائق التي تريد للنظام أن يتم تحديثه بشكل تلقائي دون الحاجة الى التحديث اليدوي . • زر إنهاء جميع العملاء العالقين = للطواري في حين حدوث أي خلل أو انقطاع الكهرباء أو الخروج لأي موظف دون انهاء عميله ، أو وجود عملاء لهم حجز وليسوا موجودين ... إلخ . الجهة اليسرى العلوية وتمثل العملاء الذين في الانتظار ( رقم الدور و الوقت الذي تم الحجز فيه ) . الكومبوبوكس الذي يمثل الموظفين المتاحين الآن ، وعند اختيار اي موظف سيتم عرض حالته ( متفرغ - في استراحة - يخدم عميل رقم .. ) وهنا تأتي صلاحيات المدير بأن يقوم بتحويل عميل هذا الموظف الى عميل محدد أو إعادته إلى حالة الإنتظار ( وهنا سيكون لهذا العميل الحق بالوصول لأول موظف متفرغ "VIP" ) .أو أن يتم من الإدارة إنهاء خدمة العميل الذي يخدمه الموظف الذي تم اختياره . إمكانية عرض الساعة باللغتين العربية والإنجليزية عند النقر على الساعة فقط . تم تقسيم قاعدة البيانات الى قواعد امامية وقاعدية بيانات خلفية ( للجداول المشتركة ) . وميزات كثيرة ستجدونها في هذا العمل المتواضع . Queue Management System.zip

السلام عليكم ورحمة الله وبركاته كثيرا ما حاولت فتح التقرير وعرضه بالتبديل من الوضع العمودي الى الوضع الأفقي خاصة عندما افتحه مخفيا على عرض التصميم للتعامل مع الحقول برمجيا وكانت النتيجة انه يمكن التعامل برمجيا مع الحقول .. وإنشاء حقول جديدة .. ويمكنني بعد ذلك عرضه للمعاينة بحقوله الجديدة ولكن استعصى علي التبديل في العرض من عمودي الى افقي والعكس .. وبعد التمعن والمحاولة عرفت السبب .. واذا عرف السبب بطل العجب وهو اني احاول التعامل مع التقرير من خلال خصائصه .. وخصائص التقرير لا تدعم هذه الميزة ثم تنبهت الى ان هذه الميزة وخصائص الهوامش وعرض الأعمدة والمسافات بين الاعمدة وغيرها يتم التحكم بها من خلال خصائص طباعة التقرير لن اطيل عليكم فبالمثال يتحقق المقال : 'للعرض الأفق DoCmd.OpenReport "Report1", acViewPreview Reports!Report1.Printer.Orientation = acPRORLandscape 'للعرض الرأسي DoCmd.OpenReport "Report1", acViewPreview Reports!Report1.Printer.Orientation = acPRORPortrait وهذه الطريقة الشاملة للتعامل Private Sub Command2_Click() ' او افتح تقريرك على التصميم وتعامل مع الحقول DoCmd.OpenReport "Report1", acViewDesign, , , acHidden 'اكتب هنا اكوادك الخاصة بالتعامل مع الحقول او العناصر الأخرى '............ '............ '............... ' ثم اختر طريقة العرض الرأسي Reports!Report1.Printer.Orientation = acPRORPortrait ' أو الأفقي 'Reports!Report1.Printer.Orientation = acPRORLandscape ' افتح التقرير للمعاينة DoCmd.OpenReport "Report1", acViewPreview End Sub فتح التقرير افقي او عمودي برمجيا.rar

إلى أصحاب الفضل علينا؛ إلى من علمونا؛ وما زلنا نتعلم منهم منتدى أوفيسنا (Excle) الكرام الأستاذ الفاضل / @أ / محمد صالح الأستاذ الفاضل / @ابراهيم الحداد الأستاذ الفاضل / @Ali Mohamed Ali الأستاذ الفاضل / @عبدالله بشير عبدالله الأستاذ الفاضل / @محمد هشام. الأستاذ الفاضل / @Foksh السلام عليكم ورحمة الله وبركاته جميعا كل عام وأنتم جميعا بخير وصحة وسعادة بمناسبة عيد الأضحى المبارك أعاده الله عليكم وعلينا وعلى الأمة الإسلامية بالخير واليمن والبركات ملحوظة: (الأسماء مرتبة تصاعديا منذ أول رد علينا)

🌿 إلى صاحب الموضوع الكريم، صاحب الوفاء والعرفان @algammal: وعليكم السلام ورحمة الله وبركاته، لقد أكرمتنا بكلماتك النبيلة، وأغدقت علينا من جميل ثنائك، فكان لتهنئتك وقعٌ في القلب لا يخفى، ولحروفك أثرٌ في النفس لا يُمحى. جزاك الله خيرًا على هذا اللطف والكرم، وأسأل الله أن يبارك لك في علمك وعملك، وأن يجعل أيامك عامرةً بالسعادة والرضا. ✨ إلى الإخوة الزملاء الأفاضل، أهل الفضل والعطاء: إنه لمن دواعي الفخر أن نكون جزءًا من هذا الصرح العلمي المبارك، حيث تتلاقى العقول، وتتعانق الأفكار، ويُسهم كل منا بما استطاع في نشر العلم وإعانة السائلين. وما نحن إلا حلقةٌ في سلسلةٍ ممتدةٍ من العطاء، ننهل من معين من سبقونا، ونستنير بهديهم. أسأل الله أن يجعل هذا المنتدى المبارك منارةً للعلم، وموئلًا للباحثين، وأن يبارك في جهود الجميع، ويجزيكم خير الجزاء على كلماتكم الطيبة التي زادتنا شرفًا وسرورًا. 🌍 إلى جميع الإخوة الأعضاء الكرام: كل عام وأنتم بخير، أعاده الله علينا وعليكم وعلى الأمة الإسلامية بالخير واليمن والبركات، وجعل أيامكم عامرةً بالمسرات، وأفئدتكم مطمئنةً بالرضا والسعادة. نسأل الله أن يديم علينا نعمة الأخوة، وأن يبارك في هذا الجمع الطيب، وأن يجعل العلم الذي نتشاركه نورًا لنا في الدنيا والآخرة. 🔹 أخوكم / محمد صالح

نعم ممكن , جرب هذا جدول 3.xlsx

مشاركة بتوضيح فكرة الأستاذ @محمد هشام. مشكوراً على فكرته الجميلة .. 1. انسخ الدالة السابقة الى مديول جديد في مشروعك الرئيسي واحفظه . 2. تستطيع تشغيل الماكرو بالنقر على Alt + F8 ، ثم تختار اسم الماكرو ، وانقر زر تشيل Run . 3. سيتم إنشاء مجلد جديد حسب الكود ( Workbook_Copy ) . وبداخله نسخة من مشروعك الأصلي لا تحتوي معادلات أو أزرار أو أكواد ... الخ . 💡 والتوظيف الذكي في الكود ، أن النسخة الناتجة لا تدعم الماكرو حتى لو حاولت إعادة تضمينها ، انظر السطر :- xlOpenXMLWorkbook ' أي .xlsx أي أنه لم يستخدم فكرة استنساخ الملف الجديد عن الأصل بنفس الإمتداد . ودمتم بخير جميعاً

وعليكم السلام ورحمة الله وبركاته ,, جرب هذا التعديل !! Sub imad() Dim doc As Document Dim db As Object Dim rs As Object Dim f As FileDialog Set doc = ActiveDocument Set db = CreateObject("DAO.DBEngine.120").OpenDatabase(ActiveDocument.Path & "\10 - TMLEK.mdb") Set rs = db.OpenRecordset("qtsder") Application.ScreenUpdating = False While Not rs.EOF With doc.Content.Find .ClearFormatting .Text = rs.Fields(0).Value .Replacement.ClearFormatting .Replacement.Text = rs.Fields(1).Value .Execute Replace:=wdReplaceAll, _ Format:=True, _ MatchCase:=True, _ MatchWholeWord:=True, _ Wrap:=wdFindContinue End With rs.MoveNext Wend rs.Close db.Close Set rs = Nothing Set db = Nothing Application.ScreenUpdating = True MsgBox "تم الانتهاء من الاستبدال بنجاح", vbInformation + vbMsgBoxRight, "" End Sub افتح الملف المرفق على اصدار 2016 ،واخبرنا بالنتيجة مجلد جديد (2).zip

كلامك سليم ومنطقي 100% 👍 ، الإعتماد على الدرجات في الخلايا لتحديد اللون فكرة أذكى وأدق ، وأنا فعلاً لم أتوجه الى هذا المنطلق بل حسب طلب الأخ في سؤاله 😅 وحتى يعمل السطر الذي تفضلتم به مع اصدارات اكسل 2010 ، هذا السطر بعد تعديله :- =IF(I9>=85,"أزرق",IF(I9>=65,"أخضر",IF(I9>=50,"أصفر","أحمر")))

و عليكم السلام ورحمة الله و بركاته تحياتي للأستاذ @Foksh الألوان تستخدم في كنترول الابتدائي و ذلك لعدم وجود طابعات ألوان فيتم كنتابة اللون . لذلك هناك حل بسيط بالمعادلات حيث يتم لصق المعادلة التالية في الخلية M7 ثم سحبها للأسفل: =IFS(I9>=85;"أزرق"; I9>=65;"أخضر"; I9>=50;"أصفر"; TRUE;"أحمر")

وعليكم السلام ورحمة الله وبركاته ,, بداية أود أن أوضح لك أنه لا يمكن لأكسل التعرف على اسم اللون كما في طلبك ، ولكن يمكننا التحايل عليه بفكرة إلتفافية حول الموضوع ، حيث أولاً يمكن استخراج رقم ( كود ) اللون ، وبذلك أولاً سنستخدم دالة بسيطة تساعدنا في هذه المهمة كالآتي :- Function GetColorCode(rng As Range) As Long GetColorCode = rng.Interior.Color End Function الآن بعد أن حصلنا على النتيجة ، سنستخدم دالة تقوم بالتعرف على اللون الناتج من الدالة السابقة ومحاولة تقريبه الى أقرب درجة معروفة سنقوم بإدخال قيمها يدوياً داخل الدالة ، كالآتي :- Function GetApproximateColorName(rng As Range) As String Dim colorCode As Long, R As Integer, G As Integer, B As Integer colorCode = rng.Interior.Color R = colorCode Mod 256 G = (colorCode \ 256) Mod 256 B = (colorCode \ 65536) Mod 256 If R > 200 And G < 50 And B < 50 Then GetApproximateColorName = "أحمر" ElseIf R > 200 And G > 200 And B < 100 Then GetApproximateColorName = "أصفر" ElseIf R > G And R > B Then GetApproximateColorName = "أحمر" ElseIf G > R And G > B Then GetApproximateColorName = "أخضر" ElseIf B > R And B > G Then GetApproximateColorName = "أزرق" ElseIf R = G And G = B Then GetApproximateColorName = IIf(R < 128, "غامق", "فاتح") & " رمادي" Else GetApproximateColorName = "لون مختلط" End If End Function طبعاً قمت بتغيير الألوان في مثالك إلى الألوان الصريحة لكل لون ( الأخضر ، الأزرق ، الأصفر ، الأحمر ) . وبهذا ، سيتم الاستدعاء في الخلية التي تريد إدراج اسم اللون فيها بهذا الشكل :- =GetApproximateColorName(K7) طبعاً فقط ضع هذا الكود في الخلية L7 ثم اسحب تحديد الخلية الى باقي الخلايا لتطبيق الكود عليها جميعاً . وهذا ملفك بعد التعديل :- Book2.xlsm

وعليكم السلام اهم شيء في موضوع هذه الطابعات هو ان يكون عندك برنامج تنصيب الطابعة من الشركة ، ولا تعتمد على تعريف الوندوز ، لأنه بعد التنصيب ، يجب عليك عمل بعض التعديلات على اعدادات الطابعة. 1. من صفحة الطابعات ، اختار خصائص الطابعة: . 2. وهنا سأعرض التخصيصات لطابعات مختلفة ، رجاء ملاحظة اسماء الطابعات: . هنا يجب ملاحظة ان بعض الطابعات تقطع الورقة حسب الاعدادات: بعد المستند او بعد كل ورقة . . وبما ان الطابعات الحرارية لا تحتاج الى مسافات/هامش لسحب الورقة ، فالافضل عمل هذا برمجيا : Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) On Error GoTo err_Detail_Format 'set the default printer margins With Application.Printers(0) .TopMargin = 0 .BottomMargin = 0 .LeftMargin = 0 .RightMargin = 0 End With . في التقرير ، وفي وضع التصميم ، اختار الطابعة (سواء بعرض 80مم او 58 مم) ، عليه تستطيع تصميم التقرير/الحقول بالطريقة العادية ، مع مراعاة عرض التقرير (ولا يهم الطول) ، وبالتجربة تستطيع تضبيط التقرير. التقارير بالبوصة (لاحظ العرض) ولا تنسى ان الطابعة تطبع باللون الاسود فقط (او اطياف اللون الرمادي) ، فتأكد من اختيار لون النص وحجمه ، وان الشعار يكون ابيض واسود (واما اذا كان ملون ، فسيتم طباعته باطياف اللون الرمادي).

1. إعداد التقرير (Report) في Access أ. إنشاء التقرير: افتح قاعدة البيانات في Access. انتقل إلى تبويب Create > Report Design. صمم التقرير يدويًا أو استخدم Report Wizard لإنشاء فاتورة بسيطة. ب. تخصيص التقرير للطباعة الحرارية: العرض (Width): للطابعات الحرارية (عرض 58 مم أو 80 مم)، اضبط عرض التقرير في Property Sheet (وحدة القياس: سنتمترات أو بوصة😞 58 مم ≈ 2.28 بوصة. 80 مم ≈ 3.15 بوصة. مثال: ' لضبط العرض في كود VBA Reports("InvoiceReport").Width = 3.15 * 1440 ' (البوصة إلى Twips) المحتوى: أضف عناصر التقرير (مربعات النص) للبيانات الأساسية: اسم المتجر، التاريخ، رقم الفاتورة، العناصر، الإجمالي. استخدم خطوطًا بسيطة مثل Arial أو Courier New بحجم مناسب (مثال: 8-10pt للتفاصيل، 12pt للعناوين). 2. إعدادات الطباعة عبر VBA أ. تحديد الطابعة الحرارية: Sub SetThermalPrinter() Dim prt As Printer For Each prt In Application.Printers If prt.DeviceName Like "*Thermal*" Then ' استبدل بـاسم طابعتك Set Application.Printer = prt Exit For End If Next prt End Sub ب. ضبط إعدادات الطباعة: Sub PrintInvoiceReport() ' تعيين الطابعة الحرارية Call SetThermalPrinter ' ضبط إعدادات التقرير قبل الطباعة With Reports("InvoiceReport") .Printer.Orientation = acPortrait ' أو acLandscape إذا needed .Printer.PaperSize = acPRPSUser ' حجم ورقة مخصص .Printer.PaperWidth = 3.15 ' لبوصة (لـ 80 مم) .Printer.PaperHeight = 0 ' طول غير محدود (لفة ورق) End With ' طباعة التقرير DoCmd.OpenReport "InvoiceReport", acViewNormal DoCmd.PrintOut acPrintAll End Sub 3. تنسيق المحتوى للطباعة الحرارية أ. محاذاة النص: اضبط خاصية Text Align في مربعات النص إلى: Right للنصوص العربية. Left للأرقام. مثال لإضافة باركود: ب. إضافة باركود أو QR (اختياري): إذا كانت الطابعة تدعم الباركود، استخدم مكتبة خارجية مثل IDAutomation أو أنشئ صورة باركود في التقرير. ' إدراج صورة باركود في التقرير Me.ImageControl.Picture = "C:\Barcode\INV123.png" 4. قص الورق تلقائيًا (إذا كانت الطابعة تدعمه) بعض الطابعات تقص الورق بأمر ESC/POS. يمكن إرساله عبر VBA إذا كان هناك اتصال مباشر: Sub SendCutCommand() Dim prt As Object Set prt = CreateObject("WinSpool.WinPrinter") prt.DeviceName = "اسم الطابعة الحرارية" prt.Open prt.Write Chr$(29) & Chr$(86) & Chr$(0) ' أمر قص الورق prt.Close End Sub 5. نصائح مهمة اختبار الطباعة: استخدم Print Preview في Access قبل الطباعة الفعلية. تأكد من عدم قطع النصوص عند الحواف. الخطوط العربية: إذا ظهرت النصوص العربية كرموز غير مقروءة، استخدم خطوطًا تدعم Unicode مثل Arial أو Times New Arabic. البيانات الديناميكية: استخدم استعلام (Query) كمصدر بيانات للتقرير لملء الفاتورة تلقائيًا. مثال كامل لفاتورة بسيطة ' إنشاء فاتورة ديناميكية Sub GenerateInvoice() Dim report As Report Set report = CreateReport() ' إضافة عناصر إلى التقرير With report ' عنوان الفاتورة Dim lblTitle As Label Set lblTitle = CreateControl("InvoiceReport", acLabel) lblTitle.Caption = "فاتورة شراء" lblTitle.Top = 100 lblTitle.Left = 500 lblTitle.FontSize = 14 lblTitle.FontBold = True ' تفاصيل الفاتورة Dim txtDetails As TextBox Set txtDetails = CreateControl("InvoiceReport", acTextBox) txtDetails.ControlSource = "SELECT ProductName, Quantity, Price FROM InvoiceDetails" End With ' طباعة الفاتورة DoCmd.OpenReport "InvoiceReport", acViewPreview End Sub باستخدام هذه الإعدادات، يمكنك طباعة فواتير واضحة ومنظمة على الطابعة الحرارية مباشرة من Access VBA.

السلام عليكم عيدكم مبارك وايامكم سعيدة ان شاء الله. كان الطلب: نريد التصوير ، وتقطيع الصورة من خلال نموذج اكسس ، والجواب كان "استوديوهات مسقط" ، بكل ما للاستوديو من ادوات 🙂 عمل البرنامج ، وبدون الدخول في التفاصيل ، والدروس ستكون في التفاصيل : تختار من البداية اذا كنت تريد استعمال كاميرا كانون Canon EOS (كاميرا واحدة او كاميرتين) ، او تستخدم ويب كام WebCam (استعملنا 4k ولكننا لم نكن راضين عن جودة الصور لإستخدامها في الهوية ، نعم ممكن استعمالها للهويات المؤقتة). عند ادخال رقم الموظف ، يأتي البرنامج بالصورة القديمة للموظف (قد يعطيك الموظف رقمه الوظيفي بالخطأ ، فمن مقارنة صورته القديم بشكله الان تستطيع ان تعرف اذا كان هو نفس الموظف) ، اذا كان هذا اول استخدام للتصوير (الانارة ، وضبط عدسة الكاميرا لوضوح الصورة ، او تقريب الصورة) ، فنقوم بعمله وملاحظة صورة الموظف من نافذة التصوير في الاكسس. نقوم بالنقر على الزر "التقط صورة من كانون" او "التقط صورة من ويب كام". في النموذج نرى الصورة التي تم التقاطها الان. نستخدم المربع الاحمر في ضبط مقاسات الصورة ، أ. يدويا عن طريق تحريك المربع او توسيعه من الاطراف او الزوايا ليلائم الحجم الذي نريد قص الصورة ، اما اذا اردنا من اكسس ان يقوم بتضيط مقاسات المربع تلقائيا (وهو الافضل والاسرع) ، فلمرة واحدة ، يجب علينا النقر على زر "نموذج الادوات" ، ثم ننقر على زر "اختيار لون الخلفية" ، مما سيعطينا ايقونة اختيار اللون ، فننقر بها على لون الخلفية (اعلى الرأس). ثم نمسك مفتاح Ctrl على الكيبورد وننقر على اي مكان في الوجه. و 95% من الوقت ، لا نحتاج الى عمل تعديل يدوي على المربع. عندما يكون المربع في المكان الصحيح ، انقر على زر "قص الصورة" ، فيقوم الاكسس باستبدال الصورة الجديدة مكان القديمة. بهذه الطريقة ، يتم تصوير وقص صورة الموظف في اقل من دقيقة واحدة ، وببساطة. ستكون هناك سلسلة من الدروس التعليمية في كيفية التعامل مع الصور في الاكسس ، هنا في هذا الموضوع ، وحتى يكون الموضوع متسلسل في افكاره ، سيكون هذا الموضوع مغلق للتعليقات. اما التعليقات والاسئلة فستكون في الموضوع التالي ان شاء الله جعفر . والتصوير كان بهذه الكاميرات .

وعليكم السلام ورحمة الله وبركاته ,, أحد الحلول التي قد تخطر ببال أي أحد ، هو الضغط والإصلاح ، ولكني اعتقد أنها لن تفيدك بشيء . وهنا سيكون هناك مقترح آخر وهو ، استيراد عناصر ومكونات قاعدة البيانات هذه الى قاعدة بيانات جديدة .

كل عام وجميع منتسبي منتدانا الغالي (أوفيسنا) بخير وصحة وعافية أعاده الله علينا وعليكم وعلى أمتنا الاسلامية بالخير واليمن والبركات.

2. تحريك الكائنات في النموذج هناك عدة طرق لتحريك الكائن ، ولكنها جميعا تعتمد على الحدث/الاحداث التالية: للكائن: . او حدث القسم اللي فيه الكائن ، والكائن هنا في قسم التفصيل Detail . ولكن من الخطأ استعمال الحدث للنموذج ، فالكائن موجود في قسم : . اول عمل قمت به (اعتقد في سنة 2005) كان على مثل هذا النموذج ، وفيه ملصق (مع اضافة المربع الان) . لاحظ انك تستطيع تحريك الملصق بمسكه من اي مكان في الكائن ، ولكن المربع الاجوف تستطيع تحريكه عند مسك حوافه/اطرافه فقط . ولما غيرنا خلفية المربع من شفاف (اجوف) الى خلفية عادية ، استطعنا تحريك المربع بمسكه من اي مكان . الكود الذي يمكننا من التحريك الملصق هو التالي ، واحد اهم الاسطر في الكود هو اول سطر (Dim lblDrag_X As Long, lblDrag_y As Long) ، بحيث هذه القيم تكون مخزنه لكل مرة يتحرك فيها الملصق Option Compare Database Option Explicit Dim lblDrag_X As Long, lblDrag_y As Long ' Private Sub lblDrag_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) On Error GoTo err_lblDrag_MouseMove Static InitX As Single Static InitY As Single If Button = acLeftButton Then If InitY <> 0 And InitX <> 0 Then lblDrag.Top = (Y - InitY) + lblDrag.Top lblDrag.Left = (X - InitX) + lblDrag.Left Else InitX = X InitY = Y End If Else InitX = 0 InitY = 0 End If lblDrag_X = lblDrag.Top lblDrag_y = lblDrag.Left lblMouseMove_Resume: Exit Sub err_lblDrag_MouseMove: If Err.Number = 2100 Then Resume lblMouseMove_Resume Else MsgBox Err.Number End If End Sub . 2.Basic_Move.mdb . ولما زاد عدد حقول النص (كانت تجينا مناقصات ولازم نعبئ المناقصات على اوراق الشركة ، يعني سعر كل مادة يجب تضبيطها حسب مكانها في ورقة المناقصة ، مع كتابة ملاحظاتنا حسب نوع المنتج) . وكان لابد من توسيع الحقل ، فاستعملت مفتاح الشفت (او Ctrl) مع الاسهم (يمين - يسار - اعلى - اسفل) . اصبح الكود اعلاه هو الاساس في تحريك حقول النص بجعله في دالة (في وحدة نمطية في مشروعي الاخير) ، ودالة اخرى لتوسيع الحقول ، اما مناداة هذه الدوال فكانت من حدث كل كائن على حدة: Private Sub Form_Current() ' Load the position and the size of the 38 TextBoxes Me.Drag01.Top = [Drag01_PositionY] Me.Drag01.Left = [Drag01_PositionX] Me.Drag01.Width = [Drag01_Width] Me.Drag01.Height = [Drag01_Height] Me.Drag02.Top = [Drag02_PositionY] ..... end sub Private Sub Drag01_KeyDown(KeyCode As Integer, Shift As Integer) Call KeyMe(KeyCode, Shift, ActiveControl, iWidth, iHeight) [Drag01_Width] = iWidth [Drag01_Height] = iHeight End Sub Private Sub Drag01_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single) Call DragMe(Button, Shift, x, Y, ActiveControl, PosX, PosY) [Drag01_PositionY] = PosY [Drag01_PositionX] = PosX End Sub ثم الدوال Public Sub DragMe(Button As Integer, Shift As Integer, x As Single, Y As Single, Drag As Control, PosX, PosY) ' Drag position Static InitX As Single Static InitY As Single If Button = acLeftButton Then If InitY <> 0 And InitX <> 0 Then Drag.Top = (Y - InitY) + Drag.Top Drag.Left = (x - InitX) + Drag.Left Else InitX = x InitY = Y End If Else InitX = 0 InitY = 0 End If PosX = Drag.Left PosY = Drag.Top End Sub Public Sub KeyMe(KeyCode As Integer, Shift As Integer, Drag As Control, iWidth, iHeight) 'Typical key down event handler : ' Right Arrow = Increase the Width ' Left Arrow = Reduce the Width ' Down Arrow = Increase the Height ' Up Arrow = Decrease the Height Select Case KeyCode Case 37 'Left arrow Drag.Width = Drag.Width - 72 Case 39 'Right arrow Drag.Width = Drag.Width + 72 Case 38 'Up arrow Drag.Height = Drag.Height - (1440 * 0.1667) Case 40 'Down arrow Drag.Height = Drag.Height + (1440 * 0.1667) End Select iWidth = Drag.Width iHeight = Drag.Height End Sub . 3.Group.mdb . ومع تعديل بسيط حتى يقبل التنسيق في حقول النص للاكسس 2007 فما فوق Drag_Drop_Locations.accdb . والان بعد ان عرفنا كيف نحرك المربع ، سنتحدث عن : طريقة تحريك اطرافه افقيا وعموديا ، تغيير مؤشر الفأرة حسب مكان المؤشر. هنا سأشير الى الفكرة ، واترككم مع البرنامج: من طول او عرض اي ضلع ، 0-25% و 75-100% يكون المؤشر لتحريك المريع. يعني اذا طول الضلع 10 ، اذن من 0-2.5 و من 7.5-10 يكون المؤشر لتحريك المربع. اما من 26-74% يكون لتحريك الضلع نفسه (من حوالي 3-7) ، وعليه يتغير المؤشر. اساس الكود هنا هو نفس الموجود في اول المشاركة هذه ، ومنه تم التوسع حسب الحاجة. . 4.Size_Move.accdb . وبعد تجارب كثيرة ومختلفة ، اتضح ان استعمال الاحداث اعلاه لكائن المربع لا تفي بالغرض لمشروعي ، والسبب هو ان الحدث يبدأ بالعمل عندما يكون المؤشر على احد اضلع المربع ، بينما لا يمكن الاستفادة من منتصف المربع ، فعليه ، تم تحويل الكود الى حدث قسم التفصيل Details ، ومنها بدأ العمل بالتبلور بصورة مرضية 🙂 الذكاء الاصطناعي كان وبالا/مشكلة عليّ في هذا المشروع ، وذلك لشح البيانات عن مثل هذا العمل في الانترنت ، فكنت اضطر الى عمل الكود الاساسي لضلع واحد ، ومن ثم الطلب منه بعمل باقي الاضلاع ، او تقييده في عمل الكود بين اسطر معينة من الكود. جعفر

سوف تجد صعوبة في نقل وتطبيق التعديل على برنامجك التعديل تم كالتالي : 1- اضافة استعلام جدولي بالدرجات جديد يخص الدور الثاني 2- اضافة حقل للتمييز بين الأرقام والألوان في الاستعلامات الثلاث التجميعية ( ترم1 /ترم2/ الدور الثاني ) 3- اضافة دالة في المديول لمناداة قيمة حقل التمييز 4- اضافة ما يلزم من ازرار وما خلفها من اكواد في نماذج اعداد النتائج ( الفصلين / الدور الثاني ) 5- اضافة خيار عند فتح التقرير ( الوان أو درجات ) وعلى هذا انصحك بنقل الكائنات الى برنامجك بدلا من التعديل الاحتراف في العمل هو .. ان جميع النتائج : ترم1 الوان و ترم 2 الوان واختبار الدور الثاني الوان /// ترم1 درجات و ترم 2 درجات واختبار الدور الثاني درجات .. كلها يتم عرضها في تقرير واحد . ولا يخفى فائدة ذلك للمطور

وعليكم السلام ورحمة الله وبركاته ، في البداية أعتقد أن الفكرة قد تكون متشعبة نوعاً ما ، بالإعتماد على النتائج التي قد تحتلف في كل مرة يتم فيها النقر على زر "توزيع الملاحظين" . لذا بعد تجربتك لهذه الفكرة البسيطة ، أخبرنا بالنتيجة وبالتفصيل . مع العلم أنه يوجد لديك فكرتين ، ومن خلال تجربتك ومتابعتك للنتائج ، اخبرنا بتفاصيل النتائج التي عادت لك . شرح الفكرة الأولى التي تمت :- السرعة في التوزيع ، حيث يعمل الكود بشكل أسرع بكثير لأنه :- يستخدم مصفوفات للتعامل مع البيانات بدلاً من الخلايا مباشرة . يعطل التحديث التلقائي وإعادة الحساب أثناء التنفيذ . ضمان عدم تكرار الملاحظ في نفس اللجنة :- يستخدم خوارزمية توزيع دائرية تضمن عدم التكرار في اللجنة الواحدة . التوزيع العادل :- يحاول توزيع الملاحظين على اللجان بالتساوي قدر الإمكان . يمر كل ملاحظ على جميع اللجان خلال فترات الامتحانات . الكود الذي تم استخدامه لهذه الفكرة ( مع دالة بسيطة مساعدة ) :- Sub DistributeObservers() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error GoTo ErrorHandler Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("الثانوية العامة") Dim observers As Range, committees As Range Dim observerCount As Long, committeeCount As Long Dim distributionRange As Range Dim i As Long, j As Long, attempts As Long Dim observerList() As Variant, committeeList() As Variant Dim distributionArray() As Variant Dim observerUsage() As Long Set observers = ws.Range("B3:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).row) observerCount = observers.Count observerList = observers.Value committeeCount = 30 ReDim committeeList(1 To committeeCount) For i = 1 To committeeCount committeeList(i) = "لجنة " & i Next i Set distributionRange = ws.Range("D3").Resize(observerCount, committeeCount) ReDim distributionArray(1 To observerCount, 1 To committeeCount) ReDim observerUsage(1 To observerCount) Dim randomizedObservers() As Variant randomizedObservers = ShuffleArray(observerList) For j = 1 To committeeCount For i = 1 To observerCount distributionArray(i, j) = randomizedObservers((i + j - 2) Mod observerCount + 1, 1) observerUsage((i + j - 2) Mod observerCount + 1) = observerUsage((i + j - 2) Mod observerCount + 1) + 1 Next i Next j distributionRange.Value = distributionArray For i = 1 To observerCount ws.Cells(i + 2, 1).Value = Application.CountIf(distributionRange, observerList(i, 1)) Next i Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "تم التوزيع بنجاح!", vbInformation + vbMsgBoxRight, "" Exit Sub ErrorHandler: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight, "" End Sub Function ShuffleArray(arr As Variant) As Variant Dim i As Long, j As Long Dim temp As Variant For i = UBound(arr) To LBound(arr) + 1 Step -1 j = Int((i - LBound(arr) + 1) * Rnd + LBound(arr)) temp = arr(i, 1) arr(i, 1) = arr(j, 1) arr(j, 1) = temp Next i ShuffleArray = arr End Function شرح الفكرة الثانية التي تمت :- بالذهاب الى التخلص من الدوال المساعدة ، أو تقييد الفكرة السابقة ، حيث تم استنباط فكرة أخرى تعمل على :- استخدام خوارزمية توزيع دائرية مباشرة بدون حاجة لفكرة خلط المصفوفات التي قد تكون ذات نتائج مختلفة في كل مرة عند التوزيع . ( وهي الفكرة التي خطرت ببالي سابقاً ) . الإعتماد على احتساب التكرارات أثناء التوزيع نفسه . معالجة البيانات كمصفوفات بدلاً من نطاقات خلايا !!!!! تقليل الوصول إلى ورقة العمل ، مما يساعد على الوصول الى نتيجة أسرع . اعتماد فكرة رسائل أكثر وصفية و تحتوي على أرقام الملاحظين واللجان . الكود الذي تم استخدامه لهذه الفكرة :- Sub DistributeObservers() On Error GoTo ErrorHandler Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("الثانوية العامة") Dim observers As Variant: observers = ws.Range("B3", ws.Cells(ws.Rows.Count, "B").End(xlUp)).Value Dim observerCount As Long: observerCount = UBound(observers) Dim committeeCount As Long: committeeCount = 30 ws.Range("A3:A" & observerCount + 2).ClearContents ws.Range("D3").Resize(observerCount, committeeCount).ClearContents Dim i As Long, j As Long For j = 1 To committeeCount For i = 1 To observerCount ws.Cells(i + 2, j + 3).Value = observers((i + j - 2) Mod observerCount + 1, 1) Next i Next j For i = 1 To observerCount ws.Cells(i + 2, 1).Value = Application.CountIf(ws.Range("D3").Resize(observerCount, committeeCount), observers(i, 1)) Next i MsgBox "تم توزيع " & observerCount & " ملاحظاً على " & committeeCount & " لجنة بنجاح", vbInformation + vbMsgBoxRight, "إنجاز" ErrorHandler: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic If Err.Number <> 0 Then MsgBox "خطأ " & Err.Number & ": " & Err.Description, vbCritical, "خطأ" End Sub وطبعاً في كلا الحالتين ، تم اضافة دالة ماكرو بسيطة لمسح القيم وتنظيف الجدول من التوزيعات :- Sub ClearDistribution() Application.ScreenUpdating = False On Error Resume Next Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("الثانوية العامة") Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).row ws.Range("D3:AH" & lastRow).ClearContents ws.Range("A3:A" & lastRow).ClearContents Application.ScreenUpdating = True MsgBox "تم مسح بيانات التوزيع بنجاح", vbInformation + vbMsgBoxRight, "" End Sub الملفين للفكرتين :- ملاحظة_ث.ع - 1.xlsm ملاحظة_ث.ع - 2.xlsm

تقبل الله طاعاتكم ، وبارك الله بكم ، ونفع بكم أخي الفاضل @algammal .. لهو شرف لي مشاركتك اسمي بين نخبة من معلمي و أساتذة هذا الصرح الكبير في هذا القسم الرائع ، وقد أسعدتَ قلبي بكلماتك الطيبة والتي إن نبعت ، فهي نابعةٌ من جمال وطيب قلبك وأصلك وخُلُقك . وكما أسلف اساتذتنا هنا سابقاً ، نحن هنا نساند بعضنا البعض بمودة ومحبة بما علمنا الله من علمه - ولا علم إلا علمه - ولله الفضل من قبل ومن بعد . وبإسمي وبإسم قسم الآكسس عموماً ، نسأل الله أن يتقبل طاعاتكم ، ونتمنى لكم عيد أضحى مبارك 🐑.

الأخ الكريم @algammal و عليكم ورحمة الله وبركاته بارك الله فيك وجزاك خير الجزاء على كلماتك الطيبة ويكفيني فخرا أن يذكر اسمي بين قامات أفاضل أتعلم منهم كل يوم ما نحن إلا تلاميذ في هذا الصرح الطيب ننهل من علمكم ونستزيد من عطائكم وبمناسبة عيد الأضحى المبارك أتقدم بأطيب التهاني وأصدق الأمنيات لجميع الأعضاء والخبراء الكرام في المنتدى أسأل الله أن يتقبل طاعاتكم ويمن عليكم بالسعادة والعافية في الدارين وكل عام وأنتم ومن تحبون بخير وفضل ورضا

وعليكم السلام ورحمة الله وبركاته الأخ الكريم صاحب الكلمة الطيبة والمشاعر النبيلة، الفاضل / algammal أسعد الله قلبك كما أسعدتنا بكلماتك التي فاحت منها الطيبة والوفاء، ووالله إنها لوسام على صدورنا، ودافع لنا لنستمر في العطاء ما حيينا. نحن لم نقدّم إلا واجبًا يسيرًا، وما نحن إلا تلاميذ في هذا الصرح الطيب، ننهل ونتعلم ونتشارك. وسعادتنا الحقيقية أن نرى ثمرة هذا التعاون في نفوس طيبة مثلكم. بمناسبة عيد الأضحى المبارك، أتقدّم إليك وإلى جميع الإخوة والأعضاء الكرام بأطيب التهاني والتبريكات، أعاده الله علينا وعليكم بالخير واليمن والبركات، وتقبّل الله طاعاتكم، وبلغكم منازل الأبرار ‏، وأكرمكم بالعفو والعافية والغفران ، ووفقكم لما يحب ربنا ويرضاه ، لكم مني خالص المحبة والتقدير،

أحسنت @hegazee هذا هو المقصود . جزاك الله خيرا . والشكر موصول للأخ @Foksh طلب آخر إن سمحت لي : أريد جمع عدد الإحضار للشخص في عمود AB في الجدول الأيسر وكذلك الانصراف في عمود AC . هل هذا ممكن ؟

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

لا ولا يهمك ,, حصل خير دي تستخدم كنوع من التعبير عن الشكر لصاحب الإجابة اللي هو تعب في كتابتها ونشرها لوجه الله مساهمة منه . وكنوع من الدعم المعنوي للأعضاء للمشاركة في جميع المواضيع . ونتمنى إنك تلاقي إجاباتك وحلول مشاكلك هنا مع نخبة من الأساتذة والمعلمين . دمتم خير سالمين

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

عاشت ايدك معلمنا الغالي @ابوخليل لقد استفدنا من علمكم الكثير فأنت مناره يهتدي بها التائهون في عالم الاكسس

بارك الله فيك معلمنا الفاضل على هذه المعلومة التي قد يكون الكثيرين ومن بينهم أخوك الصغير الي لا يعلمها فعلاً ، وقد اكون لم أستخدمها ابداً في تطبيقاتي ... شكراً لك مراراً وتكراراً على هذه المدرسة التي نتعلم منها الكثير دائماً

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

وعليكم السلام ورحمة الله تعالى وبركاته بعد معاينة آخر مشاركاتك على المنتدى إليك الكود ليتوافق مع جميع الإصدارات سواءا 32bit أو 64bit جرب هدا ربما يناسبك Option Explicit #If VBA7 Then Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long #Else Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long #End If Private Const Style As Long = -16 Private Const Menu As Long = &H80000 Private Const MIN As Long = &H20000 Private Const MAX As Long = &H10000 Private Sub UserForm_Activate() Dim xForm As LongPtr, tmps As Long xForm = FindWindow("ThunderDFrame", Me.Caption) If xForm <> 0 Then tmps = GetWindowLong(xForm, Style) tmps = tmps Or Menu Or MIN Or MAX SetWindowLong xForm, Style, tmps DrawMenuBar xForm End If End Sub TEST Minimize.xlsb

تحسينات جديدة ، وإضافات جديدة في التحديث الجديد لجعل المشروع كاملاً متكاملاً

شكرا لك أخي الكريم وبارك الله فيك وأكثر الله من أمثالك وزادك الله من علمه وشكرا جزيلا لأخي الفاضل وصديقي المخلص ( fokash )

الصراحة هذا الأمر مهم وأول مرة يمر علي شكراً لك أستاذ @ابوخليل

جزيت خيرا انتقلت المشكلة لجميع الجداول في الملف Manager Controls جرب مرفقك الأخير .. لماذا لا يستجيب للربط التلقائي ؟

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

عمل جميل ورائع ما شاء الله .. الأكثر جمالا واحترافية هو الربط التلقائي بقاعدة الجداول ولكني عثرت في الملف main على جدول غريب المصدر .. انظر الصورة

مرجع مهم لكل طالب معرفة بالضبط هذا ماكنت اعمله .. الا ان الهوامش ابقيها ثابتة .. اجعلها صفرا من خصائص التقرير نفسه

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

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

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

و عليكم السلام ورحمة الله و بركاته أبسط الطرق هي الارتباط التشعبي كما في الملف المرفق. أيضا هناك حلول من خلال الأكواد و المعادلات و لكن هذا أسهل شيء بدون أي تعقيدات و يمكن أن تطبقه بنفسك على ملفات أخرى الحساب2.xlsx

إليك أخي @algammal نسخة محدثة بعد تجربة الملف وظهور خطأ عند البحث بالرقم القومي لوحده توحيد البحث في شيت واحد v8.xlsb

السلام عليكم أستاذنا الكريم algammal بارك الله فيك وجزاك الله خير الجزاء لما أشدت به وكل عام وأنتم بخير وكلنا هنا نتعلم ونعمل على مساعدة بعضنا البعض فكما قال استاذنا الكبير ابراهيم الحداد ان كان هناك احد يستحق التقدير فهو انت فقليل من الناس من يتصف بهذه الصفات النبيلة وقليل منهم من يقر بما له فضل عليه بعد الله عز وجل فى التعلم .فخيركم من لا يبخل بما تعلمه لنشر المعرفة والمعلومات لكل من يستحقها

السلام عليكم و رحمة الله و بركاته اخى الكريم algammal كل عام و انتم بخير ان كان هناك احد يستحق التقدير فهو انت فقليل من الناس من يتصف بهذه الصفات النبيلة فشكرا لكل من تعلمنا منهم فهم اصحاب الفضل بعد الله تبارك و تعالى مرة اخرى كل عام و انتم بخير

وعليكم السلام ورحمة الله تعالى وبركاته جرب هدا Option Explicit Public Property Get WS() As Worksheet: Set WS = Sheets("الاختلافات"): End Property Sub Button1_Click() Dim i As Long SetApp False For i = 3 To 62 WS.Rows(i).Hidden = (Application.WorksheetFunction.CountA(WS.Range("B" & i & ":R" & i)) = 0) Next i SetApp True End Sub Sub Button49_Click(): SetApp False: WS.Rows("3:62").Hidden = False: SetApp True: End Sub Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next With Application .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End With On Error GoTo 0 End Sub كود إخفاء وإظهار.xlsb

وعليكم السلام ورحمة الله تعالى وبركاته اخي @AMIRBM تم تعديل الكود حسب طلبك ليعرض عمودين في ListBox داخل نموذج البحث مثلا (الإسم + التسلسل) يمكنك تعديله بما يناسبك وقد قمت بمحاولة تنقيحه وتحسينه ليكون أكثر كفاءة وتنظيما يرجى أولا تفريغ جميع الأكواد السابقة من النموذج ثم نسخ الكود التالي بالكامل Option Explicit Private ColArr As Variant Public Property Get WS() As Worksheet: Set WS = Sheets("add"): End Property Public Property Get dest() As Worksheet: Set dest = Sheets("search"): End Property Private Sub UserForm_Initialize() TextBox1.SetFocus 'قم بتحديد الأعمدة المرغوب عرضها ColArr = Array(2, 1) ' 2 = الإسم / 1 = التسلسل With ListBox1: .ColumnCount = UBound(ColArr) + 1: .ColumnWidths = "100pt;40pt": End With End Sub Private Sub TextBox1_Change() Dim c As Range, tmp As String, lastRow As Long, i As Long, listCount As Long ListBox1.Clear If IsEmpty(ColArr) Then Exit Sub tmp = Trim(TextBox1.Value) If Len(tmp) = 0 Then Exit Sub SetApp False lastRow = WS.Cells(WS.Rows.Count, ColArr(0)).End(xlUp).Row For Each c In WS.Range(WS.Cells(5, ColArr(0)), WS.Cells(lastRow, ColArr(0))) If InStr(1, c.Value, tmp, vbTextCompare) > 0 Then ListBox1.AddItem c.Value listCount = ListBox1.listCount For i = 1 To UBound(ColArr) ListBox1.List(listCount - 1, i) = c.EntireRow.Cells(1, ColArr(i)).Value Next i End If Next c SetApp True End Sub Private Sub CommandButton1_Click() Dim Irow As Long, f As Long, i As Long, xName As String, cnt As Boolean: cnt = False If ListBox1.listCount = 0 Then MsgBox "لا توجد نتائج للبحث", vbExclamation, "تنبيه": Exit Sub xName = Trim(TextBox1.Value): Irow = WS.Cells(WS.Rows.Count, ColArr(0)).End(xlUp).Row SetApp False For i = 5 To Irow If WS.Cells(i, ColArr(0)).Value = xName Then If Not cnt Then dest.Range("A8:L" & dest.Rows.Count).ClearContents f = dest.Cells(dest.Rows.Count, "A").End(xlUp).Row + 1 dest.Range("A" & f).Resize(1, 12).Value = WS.Cells(i, 2).Resize(1, 12).Value cnt = True End If Next i If Not cnt Then MsgBox "لم يتم العثور على الاسم" & xName & " ضمن كشف المرحليات", vbInformation, "نتيجة البحث" SetApp True: Unload Me End Sub Private Sub ListBox1_Click() TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 0) End Sub Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next With Application .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End With On Error GoTo 0 End Sub المرحليات أوفيسنا v2.xlsm

@محمد هشام. برجاء من كل الاخوة الكرام الي كل من يعرف الاخ محمد هشام او لا يعرفه الي كل من ساعده الاخ محمد هشام او لم يساعده ان يدعو له من كل قلبه و بخالص الدعوات ان يشقي ابنه الغالي واتمنى من الادمن المحترم انه يثبت البوست لفترة وشكرا علي قبول البوست

استاذ @mohamed_ets اولا كنا منتظرين اجابنك على اسئلة أستاذ @Foksh كي نساعدك . المهم 1- من تحليل الصورة الاولى :- حل مشكلة عدم القدرة على حفظ التغييرات في Microsoft Accessيبدو أنك تواجه مشكلة في حفظ التغييرات في قاعدة بيانات Access بسبب أن الملف مفتوح من قبل مستخدم آخر. إليك بعض الحلول الممكنة: الحلول المباشرة: إغلاق جميع نسخ Access وإعادة فتح الملف بحقوق حصرية: أغلق جميع نسخ Access المفتوحة افتح الملف مع الضغط على زر Shift أثناء الفتح أو استخدم خيار "فتح بحقوق حصرية" من قائمة File إعادة تشغيل الكمبيوتر: أحيانًا يعالج هذا المشكلة إذا كان هناك قفل على الملف بسبب عملية سابقة حلول أخرى: إنشاء نسخة جديدة من الملف: استخدم "Save As" لحفظ الملف باسم جديد أو استخدم "Compact and Repair Database" من قائمة Tools فحص وجود ملف .lck: ابحث عن ملف بنفس اسم قاعدة البيانات ولكن بامتداد .lck في نفس المجلد واحذفه إذا كنت تعمل على شبكة: تأكد من عدم وجود مستخدم آخر يصل إلى الملف تحقق من أذونات المجلد للتأكد من أن لديك حقوق الكتابة 1- من تحليل الصورة الثانية :- حل مشكلة "You do not have exclusive access to the database" في Access هذه المشكلة شائعة في Microsoft Access وتحدث عندما يحاول عدة مستخدمين تعديل التصميم في نفس الوقت، أو عندما يكون الملف مقفولاً. إليك الحلول التفصيلية: الحلول الفورية: إغلاق جميع نسخ Access وإعادة الفتح بحقوق حصرية: أغلق جميع نوافذ Access المفتوحة اضغط بزر الماوس الأيمن على ملف قاعدة البيانات اختر "فتح باستخدام" → Microsoft Access أثناء الفتح، اضغط مع الاستمرار على مفتاح Shift لفتحه في وضع الحصرية استخدام خيار "فتح بحقوق حصرية": شغّل برنامج Access أولاً (بدون فتح الملف) اذهب إلى File → Open حدد ملف قاعدة البيانات انقر على السهم الصغير بجوار زر Open واختر "Open Exclusive" حلول متقدمة: إصلاح قاعدة البيانات: من قائمة File اختر "Info" انقر على "Compact & Repair Database" احفظ نسخة جديدة من الملف حذف ملف القفل (.lck): اذهب إلى مجلد قاعدة البيانات ابحث عن ملف بنفس الاسم ولكن بامتداد .lck احذف هذا الملف (تأكد من عدم وجود أحد يستخدم قاعدة البيانات عند القيام بذلك) نسخ التقرير إلى قاعدة بيانات جديدة: أنشئ قاعدة بيانات جديدة فارغة استخدم خيار "Import" لاستيراد التقرير من القاعدة القديمة إلى الجديدة إذا كنت تعمل على شبكة: طلب من المستخدمين الآخرين الإغلاق: تأكد من عدم وجود مستخدمين آخرين يعدلون التصميم اطلب من الجميع إغلاق قاعدة البيانات مؤقتًا فحص أذونات الملف: تأكد أن لديك صلاحيات الكتابة على الملف والمجلد اضغط بزر الماوس الأيمن على الملف → Properties → Security نصائح وقائية: احفظ نسخة احتياطية من قاعدة البيانات بانتظام تجنب فتح قاعدة البيانات للتصميم من خلال الشبكة، انسخها محلياً أولاً استخدم "Split Database" إذا كان عدة مستخدمين يحتاجون الوصول جرب هذه الحلول بالترتيب، وعادةً ما يحل أحدها المشكلة. إذا استمرت المشكلة، قد تحتاج إلى فحص إضافي لإعدادات الشبكة أو أذونات الملفات. لاحظ بالتحليلين وجود عامل مشترك هو وجود ملف بنفس الاسم ولكن بامتداد .lck احذف هذا الملف (تأكد من عدم وجود أحد يستخدم قاعدة البيانات عند القيام بذلك)

قمت بتنفيذ الخطوات المذكورة بالفيديو ووصلت إلى الواجهه وقام بجلب الأوراق الموجودة بالملف ولكن يفشل في الحصول على اسماء الأعمدة

وعليكم السلام ورحمة الله تعالى وبركاته بما أنك تستخدم الأكواد على الملف أعتقد أنه بإمكانك ربط الكود بأي شكل وتقوم بوضعه فوق الصورة عادي نفس الفكرة المقترحة من الأخ @أبومروان بواسطة الأكواد مع إمكانية تحديد إسم الصورة والتعليق المرغوب إظهاره .يمكنك إظافة أي عدد من الأشكال وتعديل النطاقات بما يتناسب مع إحتياجاتك wor-v2.xlsm