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

اجعل الأرقام فى المعادلة داخل علامة التنصيص "" =IF(I1="1","القاهرة",IF(I1="2","الإسكندرية",IF(I1="3","بورسعيد",IF(I1="4","السويس",IF(I1="11","دمياط",IF(I1="12","الدقهلية",IF(I1="13","الشرقية",IF(I1="14","القليوبية",IF(I1="15","كفر الشيخ",IF(I1="16","الغربية",IF(I1="17","المنوفية",IF(I1="18","البحيرة",IF(I1="19","الاسماعيلية",IF(I1="21","الجيزة",IF(I1="22","بنى سويف",IF(I1="23","الفيوم",IF(I1="24","المنيا",IF(I1="25","اسيوط",IF(I1="26","سوهاج",IF(I1="27","قنا",IF(I1="28","أسوان",IF(I1="29","الأقصر",IF(I1="31","البحر الاحمر",IF(I1="32","الوادى الجديد",IF(I1="33","مطروح",IF(I1="34","شمال سيناء",IF(I1="35","جنوب سيناء",IF(I1="88","خارج الجمهورية","0")))))))))))))))))))))))))))) الرقم القومى.xlsx

ehab ali926 أين الضغط على الإعجاب على هذا الكود الرائع والإجابة الممتازة من استاذنا الغالى سليم ؟!!!💙

لأن الشرطة "_" لا يفهما البرنامج على انها مجرد شرطة لذلك اذا اردت ان تدرجها في نص يجب وضعها بين قوسين مثلاً Cells(5,11).value=cells(3,10).value &"_"& cells(5,9).value

اختر واحدة من الخليتين و احذف الثانية مثلاً Cells(5,11).value=cells(3,10).value أو Cells(5,11).value=cells(5,9).value

الخلاصه هنا https://www.officena.net/ib/topic/77255-هديه-الى-اخوانى-بالمنتدى-اضف-لمسه-جميلة-الى-برنامجك-بمرونه-تغير-الوانه/

لا حاجة لاضافة مزيد من الازرار او اضافة ماكرو لتحديد المزيد من الخيارات ولا حاجة ايضاً بأن تكون الكلمة المطلوبة في TextBox1 عند تنشيط اليوزر هي "In" عناوين الــ Labels تتغير حسب الـ CheckBox المختار Extra_Search.xlsm

تفضل تواتي9.xlsm

السلام عليكم مشاركة مع اخواني اضع مثال وجدت نموذج انتقاء الالوان بمنتدى اجنبي و وضعت كود لتطبيق رقم اللون على جميع النماذج ما عدا نموذج الانتقاء .. و هذا الكود بحدث عند النقر لزر الامر الذي يحمل علامة الصح بالنموذج frmSelectColor Dim frm As Object For Each frm In CurrentProject.AllForms If frm.Name <> "frmSelectColor" Then DoCmd.OpenForm frm.Name, acDesign, , , , acHidden Forms(frm.Name).Section(acDetail).BackColor = Me.txtColor DoCmd.Close acForm, frm.Name, acSaveYes End If Next يتم استيراد هذا النموذج و استخدامه لتغيير جميع نماذج البرنامج ارجو ان تكون الاضافة مفيدة لاخي السائل بالتوفيق للجميع BackColor.rar

تفضل هذا بحث اخر بالإسم ولا يمكن ان يكون هناك اكثر من بند للبحث فى وقت واحد Search by Name.xlsx

بعد اذن استاذ سليم -تفضل تم عمل قائمة منسدلة لعمود ID حتى لا يكون هناك امكانية للخطأ عند كتابة الرقم وبالتالى يتم جلب البيانات بصورة صحيحة , ويمكنك استخدام هذه المعادلة =IFERROR(VLOOKUP($A5,Sheet1!$A$2:$K$1700,MATCH(B$4,Sheet1!$A$1:$K$1,0),0),"") Vlookup.xlsx

تفضل تم عمل المطلوب اضافة الى عمل كود لتكست بوكس1 ليتم كتابة السريال تلقائى دون تدخل منك rr1.xlsm

وعليكم السلام-جرب الملف هكذا Amr2.xlsx

اخى الكريم ما هو سبب غضبك ؟!!! اليس هذا ما تريد .... فقط اجعل التنسيق هكذا [$-2000000]#,##0

برنامج الموارد البشرية HR "مفتوح المصدر" يحتوى على التالي : -بيانات الموظف . -الإجازات . - الأذنونات . - تسجيل الحضور يدوياً . - الخصومات . - السلف . - المكافأت . - تقيييم الموظف . - ساعات إضافية . - تقارير. - متابعة الحضور والانصراف . - تسجل الحضور والانصراف بشكل آلي . - تسجل الحضور بشكل يدوي . وخيارات أخرى . وهذا البرامج من تطويري وجدت جداوله في موقع خارجي . لا تنسونا من خالص الدعاء ،،، HR.rar

السلام عليكم الاستاذ الكريم سليم حاصبيا اولا اشكر لك اهتمامك المعهود ... جزاك الله خير الفكرة هي ان ممكن تكون كلمات الجملة مكونة من اكثر من لون مثال: The cat is under the table. فلو اردنا ان نلغي تحرير under مع الابقاء على باقي الكلمات كما هي فتصبح The cat is under the table. لذلك عملت زر الغاء تحرير كلمة واحدة مع ترك بقية الكلمات كما هي اعجبني الكود الجديد بما فيه من اختصارات فنية رائعة فركبته مع إضافة إمكانية التبديل بيع الغاء تحرير الكل او الغاء تحرير كلمة واحدة أشكرك جزيل الشكر على اهتمامك ... بارك الله لك في علمك Extra_Search1.xlsm

الف شكر عمل ممتاز كما عودتنا دائما جزاك الله كل خير 🙂 🤝

ربما هذا الماكرو يفي بالغرض Option Explicit Sub Crezy_filter() Dim Sh As Worksheet Dim i%, m%, Lr% Dim Obj As Object Dim My_match Set Sh = Sheets("Sheet1") Set Obj = CreateObject("Vbscript.Regexp") Lr = Sh.Cells(Rows.Count, 1).End(3).Row Sh.Range("C4").CurrentRegion.ClearContents m = 4 With Obj .Pattern = "^([A-Z][a-z]\d+)" .Global = True .ignorecase = False End With For i = 4 To Lr If Obj.test(Sh.Cells(i, 1)) Then Set My_match = Obj.Execute(Sh.Cells(i, 1)) Sh.Cells(m, 3) = Sh.Cells(i, 1) m = m + 1 End If Next Set Obj = Nothing End Sub الملف مرفق EE22.xlsm

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

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

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

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

جميل هذه محاولة..جرب وخبرنا اين الاخطاء Subjects_UPDATE4.accdb

اذا كان ملفك كبير خذ نسخة منه وقلل البيانات لا يمكن احد يجيبك لماذا هذا الخطا لانه اسبابه كثيرة

طريقة النجاح و الاكمال تحتاج الى توضيح و شرح على كلا هذا مافهمت.. ارجو الافادة اذا السجل رقم 12 صحيح انظر المرفق تحياتي Subjects_UPDATE3.accdb

يمكنك اختيار اي شيء من الخلية B2

لقد فهمت عليك ماذا تريد انظر الى هذا الملف (الصفحة Target_Sh) Indx_match_Code.xlsm

=MAX(Sheet1!$D$6:$D$17;Sheet2!$F6:$F17) تواتي9 (1).xlsm

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله خيرا وجزاه الله خيرا اخى ومعلمنا العزيز جعفر بالتوفيق اخى

صديقي لست بحاجة الى ادراج ماكرو آخر لهذا الغرض يكفي 2 تشيك بوكس واحد (لجميع الكلمات او أول كلمة ) والثاني (Bold Or Not) انظر الى هذا الملف All_Saerch_In With_User_Option.xlsm

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

بعد اذن الاخ علي هذا الملف Indx_match.xlsx

عن طريق هذا البرنامج بعت تثبيته تجد في كل برامجك (ms access) في تبويب Database Tools ثم من Add-ins ثم V-form templates V-Tools 1.83 for Access 2010-2016.rar

ممتاز اخي الرائد حتى ولو كان عندي ملاحظة بسيطة من شأنها التسريع (للبيانات الكثيرة) 1 - الدالّة IFERROR في المعادلات الأفضل عدم استعمالها الا للضروروة لأنها تلزم الاكسل على حساب المعادلة واذا وجد خطأ يدرج فراغاً (مما يضيع الوقت سدى / جزء من الف من الثانية بالنسبة للحاسوب شيء كبير جداً / ) هذا بالإضافة الى ارهاق البرنامج بأشياء لا لزوم لها 2- الأفضل استعمال CountA لانه عندما رقم الصف يتجاوز الرقم المطلوب من خلال CountA يقوم اكسل بإدراج الفراغ ولا يفكر حتى بحساب نتيجة المعادلة 3- المعادلة المفترحة من عندي =IF(ROWS(B$4:B4)>COUNTA(A$4:A$1000),"",INDEX(A$4:A$1000,SMALL(IF(A$4:A$1000<>"",ROW(A$4:A$1000)-ROW(A$4)+1),ROWS(B$4:B4))))

التعديل رائع على الكود لكن عندي ملاحظة بالنسبة لهذا الجزء منه (5 سطور) If Me.CheckBox1.Value = True Then .Bold = True Else .Bold = False End If حيث يمكن استبداله بسطر واحد .Bold = Me.CheckBox1.Value

وعليكم السلام-يمكنك استخدام المعادلة بهذه الطريقة =SUMIFS('1'!$C:$C,'1'!$A:$A,$A3,'1'!$B:$B,$B3) دالة sumifs 1مع الفلترة.xlsx

التعامل مع بيانات الويب من خلال FTP: إستقبال بيانات من موقع معين سوف نقوم في هذا الدرس إن شاء الله بشرح طريقة جلب بيانات من الويب من دون اللجوء إلى المتصفح تنبيه: في هذا المجال ليس لدي أي خبرة و قد أعتمدت على البحث في الويب لجمع المعلومات. فلربما أخطئ في ذكر أحد المصطلحات لذلك من لديه دراية بهذا الموضوع و راني أخطئ فالرجاء أن يصوبني. بروتوكول FTP: FTP هي اختصار لمجموعة كلمات File Transfer Protocol، وهي تعني بروتوكول نقل الملفات، وهذه الخدمة هي إحدى تطبيقات TCP/IP التي تجعل من الممكن نقل الملفات بين أجهزة الحاسب الآلي المختلفة و المرتبطة بشبكة الإنترنت. ينقسم نقل الملفات إلى نوعين: 1 ـ تنزيل الملفات Download: وهو جلب الملفات من الكمبيوتر المضيف Host إلى جهازك المحلي Local. و نستخدم الأمر Get 2 ـ رفع الملفات Uplaod: وهو إرسال الملفات من جهازك المحلي Local إلى الجهاز الخادم Host. و نستخدم الأمر Put - كل طلب يرسل Request يتم من خلاله استقبال رد Response أوامر FTP: هذه بعض الأوامر المستخدمة في بروتوكول FTP و التي سنحتاجها أو سنعمل عليها. 1-Post: يستخدم لارسال معلومات من المستخدم مثال: إنشاء موضوع جديد أو تسجيل الدخول كل هذا عبر Post Request 2-Get: يستخدم هذا الأمر لتنزيل ملف ما من جهاز الخادم أو عرض صورة أو صفحة. مثال: أقوم بإرسال طلب و استقبل ردًا Response يحتوي على أكواد html للصفحة 3-Put: يستخدم لرفع الملفات إلى جهاز الخادم 4-Open: يستخدم لإنشاء إتصال جديد مع الخادم 6-Close: يستخدم لإنهاء الإتصال مع جهاز الخادم مثال تطبيقي: سوف نستخدم هذا الموقع: https://uk.investing.com/rates-bonds/financial-futures سوف نقوم بإستيراد بيانات جدول من هذه الصفحة إلى جدول موجود في الملف و قد ربطه بمربعات نص لنلاحظ تنزيل البيانات هذا الكود المستخدم: Dim html As HTMLDocument, hTable As HTMLTable Dim Url As String Url = "https://uk.investing.com/rates-bonds/financial-futures" Set html = New HTMLDocument With CreateObject("MSXML2.XMLHTTP") .Open "GET", Url, False .send html.body.innerHTML = .responseText End With Set hTable = html.getElementById("cr1") For i = 1 To hTable.rows.length - 1 DoCmd.GoToRecord , , acNewRec Me.id = hTable.rows(i).cells(1).innerText Me.dd = hTable.rows(i).cells(2).innerText Me.t1 = hTable.rows(i).cells(3).innerText Me.t2 = hTable.rows(i).cells(4).innerText Me.t3 = hTable.rows(i).cells(5).innerText Me.t4 = hTable.rows(i).cells(6).innerText Me.t5 = hTable.rows(i).cells(7).innerText Me.t6 = hTable.rows(i).cells(8).innerText Next i شرح الكود: تعريف كائنات html Dim html As HTMLDocument, hTable As HTMLTable إنشاء إتصال جديد عبر السرفر MSXML2.XMLHTTP و إرسال الطلب: With CreateObject("MSXML2.XMLHTTP") .Open "GET", Url, False .send إستقبال الرد على شكل صفحة html: html.body.innerHTML = .responseText استخراج البيانات من الجدول الموجود في الرد الذي استقبلناه وقد قمنا بشرح التعامل مع الجداول في الجزء الأول بالتفصيل: Set hTable = html.getElementById("cr1") For i = 1 To hTable.rows.length - 1 DoCmd.GoToRecord , , acNewRec Me.id = hTable.rows(i).cells(1).innerText Me.dd = hTable.rows(i).cells(2).innerText Me.t1 = hTable.rows(i).cells(3).innerText Me.t2 = hTable.rows(i).cells(4).innerText Me.t3 = hTable.rows(i).cells(5).innerText Me.t4 = hTable.rows(i).cells(6).innerText Me.t5 = hTable.rows(i).cells(7).innerText Me.t6 = hTable.rows(i).cells(8).innerText Next i استخدام ftp.rar

وعليكم السلام-تفضل ............ وهذه الصورة توضح كيفية عمل قائمة منسدلة TEST-STORE1.xlsx

بعد اذن استاذنا سليم ولإثراء الموضوع ,,فهذا حل ايضا بمعادلة المصفوفة =IFERROR(INDEX(ورقة1!$C:$C,SMALL(IF(ورقة1!$B:$B=A$2,ROW(A$2:A$5000)-ROW(A$2)+1),ROWS($A$5:A5))),"") المشاريع1.xlsx

منا ومنكم سائر الأعمال ان شاء الله يمكنك هذا بمعادلة المصفوفة =IFERROR(INDEX(Data!$A:$A,SMALL(IF(Data!$C:$C=$C$1,ROW(A$2:A$5000)-ROW(A$2)+1),ROWS($A$3:A3))),"") Data_HR2.xls

فقط عليك استخدام هذه المعادلة =IFERROR(INDEX($A:$A,MATCH($E4,$B:$B,0)),"") aa.xls

المعادلة في المرفق الجدول الاصفر Conditional_Duplicate1.xlsm

بعد اذن الاخ مداد تم تغيير اسم الشيت الى اللفة الاجنبية "salim" (كما اعمل دائماً مع الاكواد لحسن عمل الماكرو من حيث النسخ واللصق) هذا الكود البسيط Option Explicit Sub get_Data() Dim S As Worksheet Dim x%: x = 4 Dim dic As Object Dim ky Set S = Worksheets("salim") S.Range("d4").CurrentRegion.ClearContents Set dic = CreateObject("Scripting.Dictionary") Do Until Cells(x, 1) = vbNullString If Not dic.exists(S.Cells(x, 1).Value) Then dic.Add (S.Cells(x, 1).Value), S.Cells(x, 1).Offset(, 1) End If x = x + 1 Loop '======================== With S.Range("d4").Resize(dic.Count) .Offset(, 1) = _ Application.Transpose(dic.items) .Value = _ Application.Transpose(dic.keys) .Offset(dic.Count).Resize(dic.Count) = _ Application.Transpose(dic.keys) For Each ky In dic.keys dic(ky) = dic(ky) + 1 Next .Offset(dic.Count, 1) = _ Application.Transpose(dic.items) End With Set dic = Nothing: Set S = Nothing End Sub الملف مرفق Conditional_Duplicate.xlsm

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