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

اعرض الملف ⚙🛠🎁 أداة لإصلاح وتعديل النصوص العربية التالفة في الأكواد .. من > ÇáÓáÇã Úáíßã إلى > السلام عليكم :: السلام عليكم ورحمة الله وبركاته :: نظرا لوجود مشكلة عند نسخ النصوص العربية في أكواد VBA وخصوصا عندما تكون لغة النظام معينة على اللغة الإنجليزية .. لذلك قمت بتصميم هذه الأداة لتقوم بإصلاح العبارات العربية التالفة في الكود وإرجاعها إلى أصلها ... مثال : ÇáÓáÇã Úáíßã >>>> تعود لأصلها : السلام عليكم وهذه صورة للأداة : صاحب الملف Moosak تمت الاضافه 04/22/25 الاقسام قسم الأكسيس  

من المفروض أولا كما سبق الدكر محاولة إلغاء دمج الخلايا لضمان أن الكود يتعامل مع كل خلية على حدة وحصولك على نتائج صحيحة جرب هدا هل يناسيك Option Explicit Public Sub Add_CheckBoxes() Dim tbl As Long, cb As OLEObject, OnRng As Range, ky As Variant Dim dataArray() As String, Search As String, n As Boolean Dim i As Long, lastRow As Long, col As Long, lastCol As Long Dim kys() As String Dim CrWS As Worksheet: Set CrWS = Sheets("MenuF") Dim dest As Worksheet: Set dest = Sheets("main sheet") Search = Trim(CrWS.Range("B1").Value) If Search = "" Then: MsgBox "يرجى إدخال قيمة البحث", vbExclamation: Exit Sub lastRow = dest.Cells(dest.Rows.Count, "A").End(xlUp).Row n = False For i = 2 To lastRow If Trim(dest.Cells(i, 1).Value) = Search Then tbl = i n = True Exit For End If Next i If Not n Then: MsgBox "قيمة البحث غير موجودة على قاعدة البيانات", vbExclamation: Exit Sub lastCol = dest.Cells(tbl, Columns.Count).End(xlToLeft).Column ReDim dataArray(1 To lastCol - 1) For col = 2 To lastCol dataArray(col - 1) = Trim(dest.Cells(tbl, col).Value) Next col For Each cb In CrWS.OLEObjects If TypeName(cb.Object) = "CheckBox" Then cb.Object.Value = False Next cb For Each OnRng In CrWS.Range("A3:I7") If OnRng.Value <> "" Then kys = Split(Replace(OnRng.Value, "،", ","), ",") For Each ky In kys For i = LBound(dataArray) To UBound(dataArray) If CompareValues(tmp(dataArray(i)), tmp(ky)) Then For Each cb In CrWS.OLEObjects If TypeName(cb.Object) = "CheckBox" Then If cb.TopLeftCell.Address = OnRng.Address Then cb.Object.Value = True Exit For End If End If Next cb End If Next i Next ky End If Next OnRng End Sub Private Function tmp(ByVal txt As String) As String tmp = Replace(Replace(Trim(txt), " ", " "), "ال", "") End Function Private Function CompareValues(val1 As String, val2 As String) As Boolean CompareValues = (InStr(1, val1, val2, vbTextCompare) > 0 Or InStr(1, val2, val1, vbTextCompare) > 0) End Function لتلوين القيم CrWS.Range("A3:I7").Font.Color = vbBlack For Each OnRng In CrWS.Range("A3:I7") If OnRng.Value <> "" Then kys = Split(Replace(OnRng.Value, "?", ","), ",") For Each ky In kys For i = LBound(dataArray) To UBound(dataArray) If CompareValues(tmp(dataArray(i)), tmp(ky)) Then For Each cb In CrWS.OLEObjects If TypeName(cb.Object) = "CheckBox" Then If cb.TopLeftCell.Address = OnRng.Address Then cb.Object.Value = True Exit For End If End If Next cb OnRng.Font.Color = vbRed End If Next i Next ky يمكنك إختيار ما يناسبك فورمة - V4.xlsb

السلام عليكم عاااااش والله لم يخطر على بالى ان ممكن نرجع الهيلوغريفى ده لعربى وكمان لم يخطر على بالى ابحث عن حل هذه المشكلة الله عليك عاش بجد شوف يا استاذنا الغالى انت لازم تعمل لعنصر التحكم اللى هيتم اللصق له او النسخ منه : SetFocus وده مهم ولابد قبل استخدام الاوامر التاليه DoCmd.RunCommand acCmdPaste أو DoCmd.RunCommand acCmdCopy مفيش حاجه اسمها على نسخة الأوفيس 365 أن هذولا السطرين ما يشتغلوا يعنى بالنسبه لمثالك بكل بساطه ده شكل كود النسخ Me.Weard_ResTxt.SetFocus DoCmd.RunCommand acCmdCopy MsgOut "تم النسخ" وده شكل كود اللصق Me.Weard_ResTxt = "" Me.Weard_OrgTxt = "" Me.Weard_OrgTxt.SetFocus DoCmd.RunCommand acCmdPaste

اعرض الملف مستورد السجلات الذكي 2025 السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) 📌 أقدم لكم اليوم فكرة قد تكون ليست بالجديدة ، ولكن بطريقة ونكهة مختلفتين ▫▪◽◾◻◼. "أداة مستورد السجلات الذكي من Excel" ، أداة مبتكرة تتيح لك استيراد البيانات من ملفات Excel إلى قواعد بيانات Access بكل مرونة وسرعة . يتميز هذا البرنامج أو الأداة بواجهة بسيطة وميزات قوية تجعل التعامل مع البيانات تجربة مريحة ، حتى للمستخدمين الذين ليست لديهم خبرة تقنية كبيرة في التعامل مع هذا النوع من المتطلبات . فالكثير من الأشخاص في منتدانا هنا سأل عن إمكانية استيراد بيانات من اكسل من حقل محدد أو بطرق محددة ( تناسب إحتياجاته ) ، ولهذا كانت الفكرة هذه تنفيذاً لمتطلباتهم .. 🎯 سنستعرض أهم ميزات هذا البرنامج وكيف يمكن أن يسهم في تحسين إنتاجيتك وتوفير وقتك . تابع القراءة لاكتشاف كيف يمكنك الاستفادة من هذا الحل الذكي لإدارة البيانات 😇 . ميزات برنامج مستورد السجلات الذكي من Excel 📂 التكامل مع Excel يمكن اختيار ملفات Excel بسهولة باستخدام نافذة اختيار الملفات . يدعم البرنامج ملفات بصيغة xls / xlsx ، وغيرها . دعم كامل للإستيراد من جوجل شيت Google Sheets . 📋 التعامل مع الأوراق والبيانات عرض جميع أوراق العمل (Sheets) الموجودة في ملف Excel المحدد ، أو رابط جوجل شيت . عرض أسماء الأعمدة في الورقة المحددة لتسهيل تحديد العمود / الأعمدة المستهدفة . 🚀 الاستيراد المرن للبيانات استيراد بيانات من عمود محدد أو عدة أعمدة من ملف Excel أو جوجل شيت بناءً على اختيار المستخدم . تحديد الصفوف التي تبدأ منها عملية الاستيراد (لتجاوز رؤوس الأعمدة إن وجدت 👌 ) . 🗂️ الإدارة المتقدمة للبيانات داخل Access استيراد البيانات إلى جدول محدد داخل قاعدة البيانات الحالية . دعم لتحديد الحقول الهدف داخل الجدول . إمكانية تفعيل خاصية الترقيم التلقائي لإضافة قيم تسلسلية إلى الحقول المخصصة ( باستخدام الدالة DMAX ) . التعرف الكامل في جوجل شيت على توافق أنوع الحقول مع الحقول في الجدول المستهدف . التعرف على عدد الحروف إن كان اكبر من 255 حرف في الحقول ذات النوع " نص قصير " ⚡ أداء عالي مع دفعات من البيانات تقسيم البيانات إلى دفعات عند استيراد كميات كبيرة لتجنب مشاكل الأداء . إدارة مرنة لعدد السجلات التي يتم استيرادها في كل دفعة . 🎨 واجهة مستخدم ديناميكية إظهار أو إخفاء المساعدة البصرية بضغطة زر . تحديث الكومبوبوكس بطريقة ديناميكيًا بناءً على اختيارات المستخدم . في القسم الخاص بجوجل شيت ، تم إضافة مساعد لخطوات إنشاء API سليم وموضح في الفيديو المرفق . 🔒 إجراءات أمان واسترجاع دعم لاسترجاع البيانات عند حدوث خطأ أثناء عملية الاستيراد ( Rollback ) . التنبيه برسائل خطأ واضحة إذا لم يتم اختيار الملف أو إعداد الخيارات بشكل صحيح . 🧹 إدارة الموارد تنظيف جميع الموارد المفتوحة (ملفات Excel أو الاتصال بالبيانات) عند إغلاق النموذج . منع أي تأثير سلبي على النظام عند حدوث خطأ . ✨ سهولة الاستخدام تصميم بسيط يعرض التعليمات ويطلب إدخال البيانات الضرورية فقط . رسائل توجيهية للمستخدم لتحسين تجربة الاستخدام . ⚙️ المرونة في تخصيص الخيارات خيارات لتحديث السجلات الموجودة أو إضافة سجلات جديدة . دعم مجموعات البيانات المختلفة من خلال تحديد طريقة المعالجة . دعم ملف اكسيل مرفوع برابط مباشر في جوجل درايف - يتم تحويله الى جوجل شيت . في الجزء الخاص بالتعامل مع جوجل شيت :- فقط اختر الرابط ( نسخ ولصق ) وادخاله في رسالة رابط الملف كما في الصورة التالية :- الأداة تدعم استكمال الجلسة لآخر رابط تم استخدامه ( توفيراً للوقت واختصاراً لفكرة استخدام الرابط نفسه في كل مرة ) ، بحيث تظهر لك رسالة كالآتي :- حيث اذا كان اختيارك لـ Yes يتم التعرف على آخر رابط تم استخدامه ( حتى بعد اغلاق الأداة ) ، وإذا كان رد المستخدم No يتم اظهار رسالة ادخال رابط جديد ( ويتم اعتماده للجلسة اللاحقة ) .. الأداة تحتوي على معالج مساعد لمساعدة المستخدم ( أول مرة فقط ) على انشاء حساب في جوجل درايف وكيفية التعامل مع الـ API الخاصة بـ Google Sheets لتهيئة الأداة للتعامل مع روابط جوجل شيت لاستيراد السجلات منه . في التحديث الجديد للأداة ، يتم التعرف على الأخطاء التي يمكن حصولها أثناء اختيار حقل وخلية لا يوجد بينهما توافق في نوع البيانات ، فمثلاً لو تم اختيار خليه تحتوي على تاريخ ويقابلها حقل في الجدول ( في آكسيس ) من نوع رقمي مثلاً ، فإن الاداة تخبرك بنوع الحقل والتصحيح الذي يمكن تعديله .. واجهة الأداة :- * صورة من الواجهة الخاصة بـ Google Sheets . يلزم إضافة مكتبة Microsoft Office xx.0 Object Library فقط .. ⭐على سبيل المثال ، لدينا جدول اكسل يحتوي على عدد سجلات يتكون من أعمدة على سبيل المثال ( اسم الموظف ، رقم الموظق ، رقم الهاتف ، الجنسية ) وعدد السجلات = 50 صف مثلاً . وفي جدول اكسيس لدينا جدول الموظفين ونريد استيراد عدد سجلات محدد من نطاق محدد من ملف اكسل أو جوجل شيت ، و من عمود محدد أو عدة أعمدة ؛ لذا بعد اختيار ملف الاكسل أو رابط ملف جوجل شيت ، سيتم :- أولاً جلب أسماء الأوراق التي يتكون منها الملف . ثانياً جلب أسماء الأعمدة التي تتكون منها الورقة التي تم اختيارها ( اسم الموظف ، رقم الموظق ، رقم الهاتف ، الجنسية ) . ونختار على سبيل المثال اسم الموظف . ثم نحدد رقم الصف الذي تبدأ به البيانات التي نريدها ، ولنفترض ان الخليه A1 تحتوي عناوين الأعمدة كما ذكرنا سابقاً ؛ وعليه فإن البيانات ستبدأ من الخلية A2 ( على العتبار ان اسم الموظف في العمود A ) في ملف اكسل . ثالثاً نحدد الجدول الذي نريد جلب واستيراد البيانات اليه ، ثم نحدد الحقل الهدف الذي سيتم نقل ابيانات اليه . رابعاً حدد عدد السجلات التي تريد جلبها ، ولنفترض أننا نريد جلب القيم الـ 5 من الخليه A2 - A6 . وإذا أردنا جلب جميع السجلات ( الـ 50 كما ذكرنا في مثالنا ) نترك القيمة في عدد السجلات المستوردة = 0 . خامساً نحدد نوع الحدث ( تحديث - إضافة ) . فماذا يعني تحديث أو إضافة ؟ تحديث : سيتم تحديث الحقل المستهدف من أول قيمة وحتى العدد المحدد في عدد السجلات المستوردة . وعليه فإن القيم السابقة للحقل سيتم استبدالها بالقيم الجديدة . إضافة : سيتم إضافة سجلات جديدة للجدول المستهدف بغض النظر عن السجلات السابقة ولن تتأثر البيانات القديمة عند الإضافة . الآن كنقطة مهمة يجب التنويه لها في هذا البرنامج ، وهي لنفترض انك استوردت عدد سجلات = 5 كما قلنا سابقاً من حقل اسم الموظف . وأردت استيراد عدد 10 سجلات من حقل رقم الهاتف ( نوع احركة تحديث ) هنا سيتم تحديث عدد السجلات الحالي في الجدول بالقيم الـ 5 الأولى ، ثم سيتم إضافة باقي القيم ( الـ 5 سجلات ) وكأنها سجلات جديدة . أي أنها حركة تحديث وحركة إضافة للقيم التي ليس لها سجلات . سادساً وهي نقطة الترقيم . اعتمدت في البرنامج على الدالة DMAX بالترقيم . بحيث يتم اضافة 1 الى أكبر قيمة في الجدول بعد تحديد حقل الترقيم ( رقم الموظف مثلاً ) . أما اذا كان لديك حقل ترقيم تلقائي في الجدول فلا يستلزم على المستخدم تفعيل هذه الميزة . سابعاً يجب على المستخدم الإلتزام بضرورة توخي الحذر عند اختيار الحقول بحيث ينتبه لنوع الحقل . فمثلاً لن يتم اضافة قيم نصية مثل اسم الموظف من اكسل الى حقل رقم الموظف ( حقل رقمي ) . وهذه النقطة لا شك فيها !! صاحب الملف Foksh تمت الاضافه 04/21/25 الاقسام قسم الأكسيس  

وعليكم السلام ورحمة الله وبركانه اليك الملف وبه التعديل ترحيل بيانات الموظف المحال للمعاش إلى شيت آخر وحذفه من قاعدة البيانات 5.xlsb وان اردت اي تعديل في الملف فايشر لك كل الود والاحترام

والله قدمت لي الكثير ادعو من الله ان يسعدك ويرزقك راحة البال ويحقق كل امانيك

لا شكر على واجب ,, هذا أقل ما يمكنني تقديمه في هذا الصرح الكبير

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

أخي الكريم ، بداية تم اضافة حقل St_Sex في جدول الطلاب ،وتمتعيين القيمة للذكور والإناث ،وعليه جرب هذا الاستعلام :- SELECT St_Code & Switch( [StudyMaterialsEng]="ARABIC","ARA", [StudyMaterialsEng]="ART","ART", [StudyMaterialsEng]="ENGLISH","ENG", [StudyMaterialsEng]="MATH","MAT", [StudyMaterialsEng]="RELIGION","REL", [StudyMaterialsEng]="SCIENCE","SCI", [StudyMaterialsEng]="SOCIAL","SOC", [StudyMaterialsEng]="SPORT","SPO" ) AS Barcode, Query1.St_Code, Query1.St_Name, Query1.St_Group, Query1.StudyMaterialsEng, Query1.St_Sex FROM Query1 ORDER BY Switch( [StudyMaterialsEng]="ARABIC",1, [StudyMaterialsEng]="ART",2, [StudyMaterialsEng]="ENGLISH",3, [StudyMaterialsEng]="MATH",4, [StudyMaterialsEng]="RELIGION",5, [StudyMaterialsEng]="SCIENCE",6, [StudyMaterialsEng]="SOCIAL",7, [StudyMaterialsEng]="SPORT",8 ), [St_Group], Switch( InStr(1, [St_Sex], "ذكر") > 0, 1, InStr(1, [St_Sex], "أنثى") > 0, 2, True, 3 ), [St_Name]; الإستعلام Query5 هل يلبي مطلبك ؟؟ باركود نهائي.accdb

طيب انا عن نفس فى الحجات اللى زى دى مش بحب اترك مربعات النص عرضه للتعديل اذ ربما يتم تغير البيانات عن طريق الخطا لذلك اقوم بتأمين مربعات النص ضد الكتابة من خلال (Locked = True) لمربعات النص طيب التعامل بيكون ازاى وعلشان ما اكتب اكود كتير بحب اضع دائما اسس اتعامل وابنى عليها يعنى انا عن نفسى سوف أضع تأمين لمربعات النص سوف اعرف ثوابت بالشكل التالى Const LOCKED As Boolean = True Const UNLOCKED As Boolean = False وهذا سوف يكون الكود المستخدم خلف زر الامر الخاص بعملية اللصق Dim btnPressed As Control Set btnPressed = Me.ActiveControl ' امسك الزر الحالي قبل ما تروح لمربع النص Me.Weard_ResTxt = "" Me.Weard_OrgTxt = "" Me.Weard_OrgTxt.LOCKED = UNLOCKED ' فك القفل Me.Weard_OrgTxt.SetFocus DoCmd.RunCommand acCmdPaste btnPressed.SetFocus ' رجع التركيز مرة أخري على زر الأمر Me.Weard_OrgTxt.LOCKED = UNLOCKED ' قفل تاني وهذا سوف يكون الكود المستخدم خلف زر النسخ Me.Weard_ResTxt.LOCKED = UNLOCKED ' فك القفل Me.Weard_ResTxt.SetFocus DoCmd.RunCommand acCmdCopy Me.Weard_ResTxt.LOCKED = LOCKED ' قفل تاني MsgOut "تم النسخ"

آمين آمين آمين والله زادكما الله من علمه وأنزل عليكما بركات من السماء

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

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

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

هذي الصرخات هي اللي مجننتنا 😂 من الأشياء اللي لاحظتها على نسخة الأوفيس 365 أن هذولا السطرين ما يشتغلوا معاي .. ولا أدري أيش السبب !!! ولذلك بحثت عن بديل .. فكان ما رأيت وبصراحة ما كثرت من البحث .. أول ما لقيت هذي الأكواد وجربتها أعتمدتها على طوووووول 😅🖐

أنت ناقد جيد ما شاء الله عليك 😅🖐 1- الأول تم تطبيقه بناءا على اقتراحك 🙂 . 2- الثاني : لا أدري 😁👊 جرب وأخبرنا ..

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

تمام الف شكر وتحية اجلال واحترام لك

السادة الكرام مسئولي ومشرفي وخبراء وأعضاء وزوار منتدي أوفيسنا (إكسيل) طبتم وطابت جميع أوقاتكم بالخير واليمن والبركات أينما كنتم وأينما حللتم وتحيتكم: السلام عليكم ورحمة الله وبركاته بخصوص موضوع سابق لنا هذا رابطه الرابط المطلوب: فقط عندما يتم في أي مرة مسح (أو إزالة) المحتويات في شيت (معاشات) أن يكون العدد (0) صفر في كل من خلية: (معاش C3؛ ذكر E3؛ أنثى H3؛ المجموع J3) حيث أنه تم ملاحظة أن العدد يظل كما هو في الخلايا المذكورة بعد مسح المحتويات أو إزالتها كما موضح بالصورة المرفقة و أرجو منكم جميعا أن تلتمسوا لنا العذر حيث أن هذه أول أمرة أتعرض فيها لمثل ذلك الأمر. ملحوظة: للسادة المشرفين الكرام تعديل اسم الموضوع بما يناسب قوانين المنتدى إن لم يكن الاسم مناسبا ودمتم جميعا بخير وصحة وعافية

أستاذي الفاضل / عبدالله بشير عبدالله السلام عليكم ورحمة الله وبركاته لقد أسرتني بعلمك وبحوارك الراقي والله أسأل أن يرزقكم الدرجات العلى من الجنة وأن يسقيكم من يد نبينا محمد (صل الله عليه وسلم) شربة لا تظمأ بعدها أبدا؛ وأن يظلكم الله في ظله يوم لا ظل إلا ظله ولن أمل من الدعاء لكم ما حييت؛ ولن أمل أيضا من قولي لكم: دمتم عونا لكل من أراد العون؛ ومثلا يحتذى لكل من أراد القدوة والله يحفظكم ويرعاكم

احسنت هذا المطلوب الملف مضبوط من ناحية المادة الدراسية ومن ناحية الصف والشعبة بقى بس ترتيب الطلاب اذا ممكن يعتمد على ترتيب جدول (TblStudent) الله يبارك فيك ولو تعبتك وازعجتك تحملني وفي ميزان حسناتك

بالتوفيق يا رب .. وربنا ينجحك بجد من قلبي

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

هههههه وانا بانتظار دوري لما توزع الحلويات عندي .. ولا إحنا ملناش من الحب جانب 😛 !! على العموم يسعدني تجربتك وإعلامي بالنتيجة أيضاً 😊 .

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

السلام عليكم حسب فهمى لطلبك وبدون ارفاق ملف منكم اليك الكود Sub RunMacroWithPassword() Dim password As String Dim userInput As String password = "1234" userInput = InputBox("من فضلك أدخل كلمة السر لتشغيل الماكرو:", "كلمة السر") If userInput = password Then MsgBox "كلمة السر صحيحة، سيتم الآن تشغيل الماكرو.", vbInformation Call MyProtectedMacro Else MsgBox "كلمة السر غير صحيحة. لن يتم تشغيل الماكرو.", vbCritical End If End Sub Sub MyProtectedMacro() MsgBox "تم تشغيل الماكرو بنجاح!", vbInformation ' أضف الكود الحقيقي هنا... End Sub الكود الاول Sub RunMacroWithPassword() وفيه المطالبة بكلمة السر وهي 1234 والكود الثاني Sub MyProtectedMacro() وهو الذي سيتم تنفيذه بعد وضع كلمة السر مثال تنفيذ ماكرو مع ادخال كلمة سر.xlsb

اممممم ، اذا كنت تعرف خطوات اضافة استعلام SQL ، فجرب الاستعلام التالي . حيث الفرز سيكون بالمادة أولاً ، ثم بالشعبة ، ثم الفرز باسم الطالب .. SELECT St_Code & Switch( [StudyMaterialsEng] = "ARABIC", "ARA", [StudyMaterialsEng] = "ART", "ART", [StudyMaterialsEng] = "ENGLISH", "ENG", [StudyMaterialsEng] = "MATH", "MAT", [StudyMaterialsEng] = "RELIGION", "REL", [StudyMaterialsEng] = "SCIENCE", "SCI", [StudyMaterialsEng] = "SOCIAL", "SOC", [StudyMaterialsEng] = "SPORT", "SPO" ) AS Barcode, Query1.St_Code, Query1.St_Name, Query1.St_Group, Query1.StudyMaterialsEng FROM Query1 ORDER BY Switch( [StudyMaterialsEng] = "ARABIC", 1, [StudyMaterialsEng] = "ART", 2, [StudyMaterialsEng] = "ENGLISH", 3, [StudyMaterialsEng] = "MATH", 4, [StudyMaterialsEng] = "RELIGION", 5, [StudyMaterialsEng] = "SCIENCE", 6, [StudyMaterialsEng] = "SOCIAL", 7, [StudyMaterialsEng] = "SPORT", 8 ), [St_Group], [St_Name]; باركود نهائي.accdb

بخدمتك استاذي هل الأن العنوان مناسب لكن لا أعلم هل شرحي واضح ام لا

الله يبارك فيك استاذي كلمة شكرا قليلة على حضرتك انت تاج الرأس

عذرا اخي الفاضل لم انتبه الى تغيير الملف في المشاركة الاولى الا الان على كل حال جرب الملف وابلغنى بالنتائج مواعيد ألأستحقاق.xlsb

أستاذي الفاضل الأستاذ / عبد الله بشير عبد الله السلام عليكم ورحمة الله وبركاته بشرك الله بالجنة؛ وبشرت بما يسرك دوما آمين رب العالمين عرفتكم بالقلب ولم أعرفكم بالنظر؛ تعارفنا بلا وجوه ولكن بالسطور أحبكم في الله ودمتم عونا لكل من أراد العون؛ ومثلا يحتذى لكل من أراد القدوة. دمتم في حفظ الله ورعايته؛ ولا حرمنا الله من فيض علمكم

تفضل ضبط كل شئ وفي اضافة جمالية بالتقرير المفصل . SamerFinal_3.rar

وعليكم السلام ورحمة الله وبركاته يبدو اثناء تجهيز الملف تغير الطلب تم التعديل حسب الطلب الجديد حسب فهمى ات H2 موعد السداد تاريخ الأستحقاق.xlsb

بعد اذن استاذي @ابو جودي تفضل استاذ @محمد119900 طلبك الاخير التعريب .... مع زيادة نموذج بحث (SearchMain) يمكنك كتابة كلمة البحث من 3 مواضع (رقم الطالب أو اسم الطالب أو الشعبة) . DDMhamed(2).rar

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

وعليكم السلام ورحمة الله تعالى وبركاته يمكنك تنفيذ ذلك باستخدام الأكواد ولكن أعتقد أنه سيكون من الضروري أولا تنظيم البيانات في ورقة العمل Menuf بشكل جيد ومن الأفضل كذلك فك الخلايا المدمجة لضمان الحصول على نتائج دقيقة ووضع الدوائر حول القيم المطلوبة بشكل صحيح إذا كان هذا يناسبك فالكود التالي ربما يساعدك في تنفيذ طلبك ' تحديد عرض الدائرة Const xWidth As Single = 40 ' تحديد طول الدائرة Const xlength As Single = 55 Sub AddDrawCircles() Dim dest As Worksheet, CrWS As Worksheet Dim Search As String, dataValue As String Dim ColArr As Long, lastRow As Long, i As Long, col As Long Dim cell As Range, OnRng As Range, shp As Shape, lastCol As Long Dim n As Boolean, a() As String, ky As Variant, r() As String On Error GoTo SupApp Set CrWS = Sheets("main sheet"): Set dest = Sheets("MenuF") Search = Trim(dest.[B1].Value) If Search = "" Then MsgBox "يرجى إدخال قيمة البحث", vbExclamation: Exit Sub SetApp False lastRow = CrWS.Cells(CrWS.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow If Trim(CrWS.Cells(i, 1).Value) = Search Then ColArr = i: n = True: Exit For Next i If Not n Then MsgBox "قيمة البحث غير موجودة على قاعدة البيانات", vbExclamation, "إنتبـــاه": GoTo CleanUp For Each shp In dest.Shapes: If Left(shp.Name, 4) = "Oval" Then shp.Delete Next shp lastCol = CrWS.Cells(ColArr, Columns.Count).End(xlToLeft).Column ReDim a(1 To lastCol - 1) For col = 2 To lastCol: a(col - 1) = Trim(CrWS.Cells(ColArr, col).Value): Next col Set OnRng = dest.Range("A3:I7") For col = 1 To 6 dataValue = a(col) If dataValue <> "" Then For Each cell In OnRng If cell.Value <> "" Then r = Split(Replace(cell.Value, "،", ","), ",") For Each ky In r If CompareValues(tmp(ky), tmp(dataValue)) Then DrawCircle cell: Exit For Next ky End If Next cell End If Next col CleanUp: SetApp True Exit Sub SupApp: Resume ExitSub ExitSub: End Sub '""""""""""""""""""""""""""""" Private Function tmp(ByVal txt As String) As String tmp = Replace(Replace(Trim(txt), " ", " "), "ال", "") End Function '"""""""""""""""""""""""""""" Private Function CompareValues(value1 As String, value2 As String) As Boolean CompareValues = (InStr(1, value1, value2, vbTextCompare) > 0 Or InStr(1, value2, value1, vbTextCompare) > 0) End Function '""""""""""""""""""""""""""""""""""""""""" Private Sub DrawCircle(cell As Range) With cell.Worksheet.Shapes.AddShape(msoShapeOval, _ cell.Left + (cell.Width - xlength) / 2, _ cell.Top + (cell.Height - xWidth) / 2, _ xlength, xWidth) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.Weight = 1.5 .Name = "Oval_" & cell.Address(False, False) End With End Sub '""""""""""""""""""""""""""" Private Sub SetApp(ByVal enable As Boolean) On Error Resume Next Application.ScreenUpdating = enable Application.EnableEvents = enable Application.DisplayAlerts = enable Application.Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End Sub وفي حدث ورقة Menuf Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Me.Range("B1")) Is Nothing Then AddDrawCircles End If End Sub فورمة - V2.xlsb

وعليكم السلام ورحمة الله وبركانه الكود يقوم بفرز الاسماء المكررة ويضعها في العمود C Sub تجميع() Dim ws As Worksheet Dim lastRow As Long, i As Long, j As Long Dim dict As Object Dim name As Variant, location As String Dim outputRow As Long Set ws = ActiveSheet Set dict = CreateObject("Scripting.Dictionary") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow name = ws.Cells(i, 1).Value location = ws.Cells(i, 2).Value If name <> "" Then If dict.Exists(name) Then dict(name) = dict(name) & " / " & location Else dict(name) = location End If End If Next i ws.Range("C1:D" & ws.Rows.Count).ClearContents outputRow = 1 For Each name In dict.Keys ws.Cells(outputRow, 3).Value = name ws.Cells(outputRow, 4).Value = dict(name) outputRow = outputRow + 1 Next name End Sub Book2.xlsb

وجدت هذا الملف بأحد المواقع الأجنبية و قمت بعمل تعديل بسيط عليه لعله يفي بالغرض حاسبة حضور و انصراف و الأجر الشهري.xlsx

السلام عليكم ورحمة الله وبركاته يرجى ان يكون ترتيب عمود (St_Name) في استعلام (Query4) مثل ترتيب عمود (St_Name) في جدول (TblStudent) وكما موضح في الصورة شرح بطريقة ثانية للتوضيح ان يكون عمود الاسم في صوره رقم واحد مثل عمود صوره رقم اثنين باركود نهائي.accdb

لا حبيبي أحتاج ترتيب الطلاب حسب ترتيب جدول ( TblStudent) اذا ممكن من فضلك