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

بفرض أن الملفين في نفس المسار(في نفس الفولدر) 2.xlsm

برنامج أرشفة 1- الملفات والمرفقات والمجلدات 2- البرامج المساعدة ومرفقاتها أرجو ابداء رأيكم به ArchiveMyFiles-Folders.rar

وعليكم السلام تفضل أخي الكريم ولكن أرجو الانتباه إلى أرقام الصفحات يجب أن تمون دائما بالشكل (-12-) عدلت بعضها مثل (-12) أرجو تعديل الباقي أي استفسار انا جاهز kutub202022 (1).xlsm

بعد اذن أخي الكريم @ابو البشر اسمح لي ان اقتنص شكل نموذجك المقترح واكمل عليه المطلوب ...... ملاحظة :::: - يجب تنصيب اخر نسخة من الواتس في الجهاز - يجب تفعيل الامان في بريدك الخاص بالجي ميل - يجب الضغط على الضبط اول مرة فقط لتسجيل بريدك في الجي ميل والباس بعد تفعيل الامان فيه - يجب اولا لارسال رسائل الواتس تشغيل برنامج الواتس ثم الضغط على زر ارسال رسائل الواتس جرب واعلمنا بالنتيجة ............................ مجلد جديد (3).rar

إن شاء الله التقرير.xlsm

بارك الله

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

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

البرنامج لارشفة السجلات وحفط المستندات يحقظ المستندات داخل البرنامج بدون مسار للمحفوظات يمكن نقل البرنامج لائي برتشن او مجلد او اي جهاز دون فقد المحفوظات المحفوظات.accdb

🤐

ابحث عن السطر الموجود في الصورة واوقف عمله بوضع الفاصلة كما في الصورة ثم شغل البرنامج وارسل رسالة البريد ثم اذهب الى المجلد الموجود بجوار البرنامج والمسمى بالشهادات هل فيها ملف PDF ؟؟؟

امين واياك ... هل فكيت الضغط عند الملف والمجلد ....

شكرا لك أخي العزيز @kkhalifa1960 جهد رائع وعمل تشكر عليه وجعله الله في ميزان حسناتك 🙂 ومثل ما قال أخي @TQTHAMI البرنامج إبداع ولكنه مزحوم جدا .. يحتاج إلى تبسيط من ناحية تقسيم الخدمات اللي يوفرها أوالألوان والأشكال والخطوط المتداخلة .. وحبذا مع شرح مبسط لكيفية الاستخدام 😊

لا اعلم لماذا مايكروسوفت لم تضع هذا الكود البرمجي ضمن جميع النسخ ...بحيث لا يحتاج المبرمج ان يكتب هذا الكود ؟

استدل السطر كاملا بهذا .................. #If VBA7 Then Private Declare PtrSafe Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long #Else Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long #End If

لانك تستخدم نسخة 64 ضع ptrsafe بعد ال Declare

تفضل أخي بدون مسافة "" بينهم d=[a]& "" & [b]

السلام عليكم ورحمه الله وبركاته مشاركه مع الاستاذ @kkhalifa1960 جزاه الله خيرا وعلى قد فهمى المرفق الاول حسب الطلب فى اول المنشور انظر الاستعلام 551 المرفق الثانى على حسب تعديلاتك للاستعلام الجدولى انظر الاستعلام qryTotal ان شاء الله يكون ما تريد تقبلوا تحياتى وبالتوفيق طلب المساعدة_1.accdb طلب المساعدة_2.accdb

الف مليون شكرا لحضرتك @Eng.Qassim انا كنت حليت المشكلة بعمل نموذج فرعي ياخد القيمة منه مباشرة جزاك الله خير ده مشروع خيري وفي مشكلة ثانية سوف ارفقها فس سوال جديد والف شكرا لكرمك

تابع الموضوع اعلاه .............

السلام عليكم ورحمة الله وبركاتة ماشاء الله قمة في في الابداع عمل رائع ومجهود جبار لكن عندي ملاحظة وهي : 1- كثرة الالوان 2- الخط صغير هل تسمح لي بتغير الشكل وانزالة مرة اخرى

1- لان الأرقام غير موجودة بالاساس

طيب جرب الان بالنسبة للخطأ الحاصل MO.rar

السلام عليكم و رحمة الله و بركاته الاخ الاستاذ @محي الدين ابو البشر الكود بعد التعديل يعمل جيدا و جزاك الله الجنة استفسار 1. لماذ لا يظهر الرقم المتسلسل حسب الاسم يعني من 1-10 و الصفحة التي تليها 11-20 و حسب اعداد الطلبة 2. اذا ممكن كود مسح النموذج الاستقبال بيانات جديد ( كود مسح ) و اعتذر منك و شكرا جزيلا لك و بارك الله في علمك و في ميزان حسناتك

اخي وليد المصرى 1 اسف علي التأخير تفضل تطابق ارقام.xlsm هذا الكود المستخدم Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim m As Integer m = 7 Do While Cells(m, "b") & Cells(m, "h") <> "" If Cells(m, "b") & Cells(m, "h") >= 1 Then Application.ScreenUpdating = False ' Cells(m, "g") = _ "=IF(RC[-5]&RC[1]="""",""No "",IF(RC[-5]-RC[1],""Can Extension"",""DONE""))" Cells(m, "g") = Cells(m, "g").Value Else Cells(m, "K") = "" End If m = m + 1 Loop Application.ScreenUpdating = True End Sub

حسب ما علمت فعلا أن بعض الدول العربية تحضر الموقع (مصر مثلا) ، ولكن يمكن تجاوز ذلك باستخدام الشبكات الخاصة الافتراضية . 🙂

الحمدلله الذي تتم بنعمته الصالحات

تفضل اخي الكريم بالتوفيق Database2.accdb

كما طلبت مصنف رقم 1_02.xlsx

السلام عليكم بالنسبة للسؤال الاول / اعمل مجلد بجانب قاعدة البيانات للصور يكون مسارها حسب كل سجل وهكذا لاتتضخم قاعدة البيانات ويوجد بالموقع الكثير من الامثلة عن ذلك بالنسبة للسؤال الثاني / حسب فهمي للموضوع انه كل صورة خاصة بموظف معين يجب ان تاخذ مسار معين بالملف (مجرد تديد الصورة من قاعدة البيانات ) تحياتي

فقط استبدل بالكود القديم Sub Test() Dim a, b, x Dim i, ii Dim nmsht, dt, bk Dim p As Long Dim ar As Long Dim tmp, class, br, mat Const c As Integer = 25 Set nmsht = Sheets("name") Set dt = Sheets("data") Set bk = Sheets("Book") b = dt.Range(dt.Range("B4"), dt.Range("B4").End(xlDown)).Resize(, 3) p = 4: For i = 1 To UBound(b) tmp = Split(b(i, 1)) class = IIf(UBound(tmp) < 3, tmp(1), (tmp(0) & " " & tmp(1)) & " " & tmp(2)) br = tmp(UBound(tmp)): mat = b(i, 3) With nmsht.Range("b2:AX400") x = .Find(b(i, 1), , , 1).Address a = .Range(x).Offset(3, -1).Resize(.Range(nmsht.Range(x).Offset(3), nmsht.Range(x).Offset(3).End(xlDown)).Count, 2).Offset(-2, -1) End With ar = 1 With Sheets("book") For ii = 1 To UBound(a) Step c x = Split(.[E:E].Find("-" & p & "-", , , 1).Address, "$")(2) .Cells(x - 6 - c, 4) = .Cells(x - 6 - c, 4) & " " & class .Cells(x - 6 - c, 9) = .Cells(x - 6 - c, 9) & " " & br .Cells(x - 6 - c, 15) = mat zzZ = Application.IfError(Application.Index(a, Evaluate("(Row(" & ar & ":" & ar + c & "))"), Array(1, 2)), "") For i = 1 To 10 .Cells(x - 1 - c, 2 + m) = Z(i, 2) mm = mm + 4 Next ar = ar + c p = p + 2 Next End With Next End Sub

عادة الخلايا المدموجة والأكواد لا يتفقان لذلك.....!!

سلطنة عمان الرائعة والجميلة 😊✌️🏻

تم التصحيح لا بد أن يكون نوع/تنسيق الخلية في الجدولين متساوي ، عليه حولت لك النوع في صفحة البحث من نصي إلى رقمي باستخدام دالة Value Filename_02.xlsx

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

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

اخى الفاضل جرب المعادلة التالية =IF(COUNTIF(INDIRECT("'"&D$2&"'!$B$3:$B$6");$B3)>0;1;"") نتائج.rar

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

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

اسأل الله ان يفرج همنا وهمك ويرفع عنك كل بلاء, شدة وتزول اخي الكريم ....... عرفته يمنياً في تلفته خوفٌ...وعيناه تاريخ من الرمدِ من خضرة القات في عينيه اسئلة...صفر تبوح كعودٍ نصف متقدِ

السلام عليكم ورحمة الله وبركاته الاخوة الاعزاء والاساتذة الكرام جزاكم الله خيرا ارجو ابداء المساعدة لغرض ترحيل الطلبة المنقولين من ورقة ( الاسماء حسب الفصول) , ترحيلهم ومسح بياناتهم الى ورقة المنقولين من المدرسة والشرط وضعته في العمود ( U ) في ورقة ( الاسماء حسب الفصول) وهو كلمة ( نقل) فكل طالب امام اسمه كلمة نقل ترحيل بياناته وتمسح نهائيا من ورقة (الاسماء حسب الفصول ) دون ان تمسح المعادلات الموجودة في ورقة (الاسماء حسب الفصول )علما بان الفصول تحت بعض لكن بفاصل لكل 50 طالب اثابكم الله وزادكم من فضله علما وخيرا كثيرا تقبلوا فائق احترامي وتقديري قوائم المدرسة.rar

السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة تقبلوا تحياتي وشكري

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

السلام عليكم بعد اذن اخي الحبيب ابو حنين هذا الكود اعددته مع المسح والفرز للجداول يجب تنفيذ الكود من الورقة (الاسماء حسب القصول) Sub kh_trheel() Dim cel As Range Dim Lr As Long, Lrr As Long, R As Long, i As Long, iCont As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Lrr = Cells(Rows.Count, "C").End(xlUp).Row With Sheets("المنقولين من المدرسة") Lr = .Cells(Rows.Count, "B").End(xlUp).Row iCont = WorksheetFunction.Max(.Range("A5").Resize(Lr)) For R = 5 To Lrr If Cells(R, "U").Value = "نقل" Then i = i + 1 .Cells(Lr + i, "A").Value = iCont + i .Cells(Lr + i, "B").Resize(1, 8).Value = Cells(R, "B").Resize(1, 8).Value If cel Is Nothing Then Set cel = Cells(R, "A").Resize(1, 23) Else Set cel = Union(cel, Cells(R, "A").Resize(1, 23)) End If Next End With If i Then On Error Resume Next cel.SpecialCells(xlCellTypeConstants).ClearContents On Error GoTo 0 For R = 5 To Lrr Step 53 With Cells(R, "A").Resize(50, 23) .Sort .Columns(3), xlAscending End With Next End If Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Set cel = Nothing End Sub تحياتي

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

السلام عليكم استعمل هذا الكود Sub sCopy_To() Application.ScreenUpdating = False lr = Sheets("الاسماء حسب القصول").Cells(Rows.Count, "C").End(xlUp).Row + 1 x = 5 For i = 1 To lr If Sheets("الاسماء حسب القصول").Cells(i, 21) = "نقل" Then Sheets("الاسماء حسب القصول").Range("B" & i).Resize(1, 9).Copy With Sheets("المنقولين من المدرسة") .Range("B" & x).PasteSpecial xlPasteValues .Range("A" & x) = x - 4 End With x = x + 1 End If Next Application.ScreenUpdating = True Application.CutCopyMode = False End Sub

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

أخي الحبيب ( عباس) أولاشكرا علي كلماتك الرقيقة التي تفوقني بكثير ثانيا الحمد لله والشكرلله أن المعادلة حققت طلبك وهذا هو الهدف الأساسي ثانيا - ليه حضرتك نزلت شرط الكسر الأقل من ال( .5 ) إلي الرقم الصحيح وهو الصفر لأن بكده كل الأقل من النصف يتساوي ( أويرفع ) مثلة مثل الأكبر من أو يساوي النصف لأن المعادلة : أللي بتحقق الشرط الأخير هي: =IF(OR(L24<>"";M24<>"");IF(ABS(SUM(L24:M24))/2-INT(SUM(L24:M24)/2)>=.5;INT(SUM(L24:M24)/2)+1;SUM(L24:M24)/2);"")

السلام عليكم ورحمة الله وبركاته الاستاذ الفاضل محمود زادك الله علما ومعرفة وبارك الله في رزقك المعادلة رائعة وهي التي تتخلص من الكسور العشرية لكل متوسط حسابي وفي النهاية يصبح الناتج صحيحا 100% وانا اكملت معادلة المتوسط الحسابي للخلايا (L)حسب معرفتي المتواضعة ارجو مراجعتها اذا كان في المعادلة خطأ ام لا. اخي الحبيب , المشكلة في معادلة AVERAGE تبقي على الكسور العشرية وهي التي تحدث المشكلة في النهاية واستمحيك عذرا كون طلباتي كانت كثيرة ولكن كما تعلم اخي الحبيب هذه حقوق الطلبة ونحن نريد ان نحافظ على استحقاقاتهم بالكامل واحيانا الدرجة يتوقف عليها مصير الطالب بارك الله فيك وحفظك ورعاك ورزقك من حيث تحتسب ومن حيث لاتحتسب والسلام عليكم ورحمة الله وبركاته تعديل معادلة المتوسط الحسابي .rar

أخي الحبيب ( عباس ) أنطر المرفق ستجد أن الحسابات مظبوطة وهناك معادلة ( average ) يمكن تطبيقها مباشرة دون هذه اللفة بالأضافة ألي أن الحل بالطريقتين أعطي نفس النتيجة جبر الكسر في المتوسط الحسابي .rar