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

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

السلام عليكم اعضاء واساتذة منتدانا الغالي هذه محاولة وتعديل لمشاركة احد الاخوة الكرام فيما يخص الصلاحيات لقاعدة البيانات اكواد تشفير الرقم السري هي نفسها المستخدمة سابقا بالاضافة مع الاستعانة ببعض الشروح ملاحظة : في القاعدة اربعة مستخدمين ثلاثة منهم بصلاحيات محدودة والادمن بصلاحيات كاملة اسم المستخدم كلمة السر admin 0 A 1 B 2 C 3 Root1000.rar

السلام عليكم تقضل طلبك كما في الصورة بعد التعديل مرفق ملفك تحياتي برنامج الحضور والغياب للطلاب بالباركود.rar

🙂

السبب هو عدد الحقول التي طلبتها ، اضف العلامة | في الدالة NZ ، بعددها في الكود بمعنى عندك 9 علامات : فلازم NZ يكون : جرب هذا A = Nz(DLookup("[ITEM_CODE] & '|' & [deskwn1] & '|' & [item_name] & '|' & [Expr1]& '|' & [Expr2] & '|' & [sub_id] & '|' & [FACTOR]& '|' & [UNT_ID]& '|' & [ITEM_CommissioN]& '|' & [CATEGORY]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'"), "|||||||||") جعفر

تفضل اكتب اي كلمة test34.xlsm

Try this file Offecna.xlsx

شاهد هذا الفيديو https://www.youtube.com/watch?v=0YNhxVu2a5s

اتفضل اخى حسين Me.EDET_QOTY = DLookup("[Qote_item]", "tabol102", "item_prais=" & [item_prais] & "and [ITEM_BARCODE]='" & Me.serh_Barcod & "'") DCount("ITEM_BARCODE", "tabol102", "ITEM_BARCODE = forms!forms_1!serh_Barcod and [item_prais]=forms!forms_1![item_prais]") test_1.accdb

جرب هذا الملف Ages.xlsx

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

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

بعد اذن استاذ محمد يتم الترحيل بعد تنشيط الورقة باسم all test_2.xlsm

تم

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

انا قلت برضو كده بصراحه تسلم ايدك استاذي الفاضل jjafferr والشكر كل الشكر لاستاذي الفاضل أحمد الفلاحجى والله ماقصر وكوده ممتاذ بس انا من طبعي بحب الكود يكون صغير / خير الكلام ما قل وذل 😂 والف شكر للجميع وجعله الله في ميزان حسناتكم

السلام عليكم في تذييل التقرير اكتب في مربع نص غير منضم الكود التالي =Count(*) تحياتي Database2.rar

الحمدالله تم عمل الازم تمام التمام شكرا خالد

بالانتظار استاذي شكرا لك

جزاك الله خير المحسنين

استاذي الفاضل jjafferr بخصوص هذا الكود انه ممتاذ جدا انا جربته فوق الممتاز وفر علي جهود كثيره زادك الله من علمه وجعله في ميزان حسناتك Dim x() As String A = DLookup("[pn] & '|' & [Size] & '|' & [Vendor] & '|' & [Description] & '|' & [Maxrl] & '|' & [Maxrlegyptair] & '|' & [actype] & '|' & [pos] & '|' & [biasradial] & '|' & [code]", "code", "[pn]=forms!frm_dataentry!Combopn") x = Split(A, "|") ' For i = LBound(x) To UBound(x) ' Debug.Print x(i) ' Next i Me.pn = x(0) Me.size = x(1) Me.vendor = x(2) Me.Description = x(3) Me.Maxrl = x(4) Me.Maxrlegyptair = x(5) Me.ACType = x(6) Me.Pos = x(7) Me.BiasRadial = x(8) Me.code = x(9)

ما عليك الا اضافة 1 (او اي رقم تريده) الى المعادلة كي تصبح هكذا =IF(OR(A2="",B2=""),"",DATEDIF(DATE(B2,1,1),TODAY(),"y")+1)

شكرا أخي سليم حاصبيا الملف ممتاز وساعدني لعملي جزاك الله خيرا

كالعادة استاذ على دائما تحفنا باعمالك الجميلة

السلام عليكم اخوي احمد 🙂 أنا قد اجبت على سؤال الموضوع ، واخبرتك 🙂 فرجاء فتح موضوع جديد والاشارة الى هذا السؤال ، ورجاء تجاوب فيه على الاسئلة اللي طرحتها عليك (لأنك لم تجاوب عليها) ، حتى يعرف الاعضاء كيف يمكنهم مساعدتك 🙂 جعفر

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

مثل هذا الجهاز AT9000 ، ويعمل بنفس طريقة الجهاز CR100 بأته يأخذ كود MRZ ويفككه (وسيكون مشروعي التالي ان شاء الله 🙂 ) ، وبالاضافة يأخذ: صورة ملونة لصفحة الجواز ، صورة ابيض واسود لصفحة الجواز (لكشف التزوير) ، صورة من صورة صاحب الجواز الشخصية ، . . نعم يمكن التحكم في هذا ، بطريقتين: عن طريق ملف XML ، او بتفكيك السطر على اساس علامات "<" (لاحظ الوحدة النمطية في مشاركتي الأولى) ، او الاثنين معا 🙂 جعفر

السلام عليكم هل تقصد تحديث النموذج الفرعي Sub per Line الموجود غي النموذج الرئيسي Main per Line بواسطة الزر Calculate المهم وجدت هذا الكود في حدث عند نقر زر Calculate انت عامله لفتح استعلام ؟؟؟ DoCmd.OpenQuery "Main TABL, acViewNormal, acReadOnly" تحياتي انظر للمرفق DRI Plant # 01.rar

وعليكم السلام ورحمة الله وبركاته =DATE(YEAR(A1);MONTH(A1)+B2;DAY(A1)) =DATE(YEAR(A1);MONTH(A1)+3;DAY(A1)) معادلتين : إما كتابة الرقم المضاف أو تعيين خلية لإضافة الرقم للشهر المعادلة تؤدي الغرض ويمكن للأساتذة أضافة نستفيد منها Month+3.xlsx

وعليكم السلام 🙂 اسمح لي اشارك معاك اخوي خالد 🙂 انا شايف ان الرقم العشوائي مجرد تمويه ، او لم يتم استعماله بالطريقة الصحيحة في الكود !! الكود يطلب منك كلمة السر ويحتفظ بها في المتغير x ، المتغير z يعمل عملية حسابية على كلمة السر التي ادخلتها ، اذا كانت كلمة السر صحيحة ، فيخبرك انها صحيحة ويفتح لك النموذج "معلومات التقارير" ، واذا كانت فيخبرك انها خطأ ويغلق النموذج "معلومات التقارير" !! ولكن النموذج "معلومات التقارير" : يا انه مُغلق ، فيتم فتحه ، او مفتوح فيتم غلقه ، ولكن الكود يعمل الاثنين ، حسب صحّة كلمة السر !! جعفر

جرب هذا الملف My_Book.xlsm

وهذا ما يفعله الكود الذي رفعته لك بالضبط (لكن بدون رقم سري ) اذا اردت يمكن وضع رقم سري بالكود

اولا الف شكر للاخ الكريم ووجدت طريقة اخرى قمت باستخدامها وهي الغاء الحماية عن كل الخلايا مثل الصورة المرفقة ثم عمل حماية على الخلايا او الاعمدة المراد حمايتها فقط ( locked ) من ثم عمل protect sheet لها مثل الصور المرفقة

تحية طيبة وعطرة... تفضل ما طلبته في الملف المرفق... بن علية حاجي Cash at Banks (TEST).xlsm

السلام عليكم ورحمة الله تم عمل المطلوب في الملف المرفق... أرجو أن تفي الغرض المطلوب.. بن علية حاجي ملاحظة: تم تصحيح خطأ في المعادلة الثانية للإحداثيات في الملف المرفق (خطأ في الإشارة).. معذرة لذلك... (النتائج المحصل عليها تمت في معلم متعامد ومتجانس) Circle & Center.xls

لم أفهم سؤالك جيداَ يمكنك الذهاب الى اي خلية رقم عامودها اكبر من 3 هناك طريقة ثانية بحماية الصفحة مع عدم السماح بالتحرير في هذه الثلاثة أعمدة مثلاً Sub Protct_Three_columns() With Sheets("ورقة1") .Unprotect .ScrollArea = "" .Cells.Locked = False .Range("A3:c3").EntireColumn.Locked = True .Protect End With End Sub

شكراً استاذ محسن و لي انا بهذا الشأن هذا الماكرو (عسى ان ينال الإعجاب) Option Explicit Sub S_H_Test_NEW() Dim D As Worksheet: Set D = Sheets("Data") Dim M As Worksheet: Set M = Sheets("المطلوب") Dim ARR(): ARR = Array("S", "G", "C", "H") Dim Obj As Object, i%, Chek%, t% Set Obj = CreateObject("Scripting.Dictionary") M.Range("K2").CurrentRegion.ClearContents i = 2 Do Until D.Range("F" & i) = vbNullString For t = 1 To 4 Chek = Chek + (UCase(M.Cells(2, t)) = _ UCase(D.Cells(i, ARR(t - 1)))) Next If Chek = -4 Then _ Obj.Add i, D.Cells(i, "F") i = i + 1: Chek = 0 Loop If Obj.Count Then _ M.Cells(2, "k").Resize(Obj.Count) = _ Application.Transpose(Obj.items) Set Obj = Nothing: Set D = Nothing: Set M = Nothing Erase ARR End Sub الملف من جديد MY_search_MD_SH.xlsm

مبدع دائما أستاذنا الكبير / سليم وإثراء للموضوع يمكن تجربة الكود التالى لاستدعء البيانات بأكثر من شرط Option Explicit Sub M_D_Test() Dim ws As Worksheet: Set ws = Sheets("Data") Dim sh As Worksheet: Set sh = Sheets("المطلوب") Dim Arr As Variant, Arr1 As Variant, Temp As Variant Dim lr As Long, I As Long, j As Long, P As Long lr = ws.Range("C" & Rows.Count).End(xlUp).Row '------------------------------------ Application.ScreenUpdating = False sh.Range("H2:H22").ClearContents Arr = ws.Range("A2:Z" & lr).Value '=================== Arr1 = Array(5) '==================== ReDim Temp(1 To UBound(Arr, 1) + 1, 0 To UBound(Arr1) + 1) For I = 1 To UBound(Arr) ' الـ 3 شروط ' ================================================================================================== If Arr(I, 19) = sh.[A2].Value And Arr(I, 7) = sh.[B2].Value And Arr(I, 3) = sh.[C2].Value Then '================================================================================================== P = P + 1 For j = 0 To UBound(Arr1) Temp(P, j) = Arr(I, Arr1(j)) Next j End If Next I If P > 0 Then sh.Range("H2").Resize(P, UBound(Temp, 2)).Value = Temp '------------------------------------ Application.ScreenUpdating = True End Sub MY_search_MD.xlsm

جرب هذا الملف MY_search.xlsx

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد... يمكن عمل ذلك بدالة مستحدثة عن طريق VBA (والذي هو ليس من امكانياتي)... بن علية حاجي فصل أيام الغياب.xlsx

نعم اخي تفضل شاهد المرفقات Test_1.xls

شيت مستر ملاك 2020 للمرحلة الإبتدائية شيت كنترول كامل لكل الصفوف من الأول الى السادس الابتدائى على أحدث التعليمات الواردة من الوزارة حسب قرار 311 الصادر فى 28 / 11 / 2019 و الخاص بتعديل مادة التربية الرياضية يحتوى على : 1- البيانات الاساسية 2- كشوف مناداة التلاميذ 3- لاصقات أرقام الجلوس 4- أرقام الجلوس مع جدول الامتحانات 5- قوائم الفصول 6- كشوف درجات المواد و الانشطة 7- شيت متكامل 8- نتيجة شاملة 9- احصاء 10- احصاء الجودة 11- الشهادات تقديرات فقط و تقديرات و درجات معاً 12- العشرة الأوائل 13- شهادات تقدير للأوائل يتميز بــ : سهولة التعامل صغر الحجم شامل كل المعلومات المطلوبة فى الامتحانات طباعة سريعة لكل صفحات الشيت بضغطة واحدة امكانية الترتيب الأبجدى بضغطة واحدة مع قبول أى اقتراحات جديدة كلمة المرور : 333 التحميل : http://www.mediafire.com/file/0dhgmo0446n5bwy/%D8%B4%D9%8A%D8%AA_%D9%85%D8%B3%D8%AA%D8%B1_%D9%85%D9%84%D8%A7%D9%83_2020_%D9%84%D9%84%D9%85%D8%B1%D8%AD%D9%84%D8%A9_%D8%A7%D9%84%D8%A5%D8%A8%D8%AA%D8%AF%D8%A7%D8%A6%D9%8A%D8%A9_20-1-2020.rar/file

جرب هذا الماكرو Option Explicit Sub Join_by_three() Dim my_rg As Range Dim lr%, i%, col%, m%, k% col = Cells(1, Columns.Count).End(1).Column lr = Range("a2", Range("A1")).End(4).Row m = lr + 2 Range("a" & m).Resize(10000, 3 * col).Clear For i = 1 To lr Step 3 For k = 0 To 2 Range("a" & i + k).Resize(, col).Copy _ Range("a" & m).Offset(, k * col) Next k m = m + 1 Next i End Sub MY_one_file.xlsm

الحلقة السادسة: تابع لدرس التعامل مع الجداول في صفحة ويب في الدرس الماضي قمنا بالتعامل مع جدول له خاصية id و في هذا الجدول سوف نتعلم كيفية التعامل مع الجداول التي ليس لها خاصية id أو name سوف نعتمد في هذا الدرس على خاصية Tagname التطبيق سوف يكون على صفحة ويكيبيديا: https://mawdoo3.com/جميع_دول_العالم_وعواصمها 1- كود حساب عدد الجدول في الصفحة: MsgBox WebBrowser3.Document.getElementsByTagName("table").Length 2- كود حساب عدد الخلايا في الجدول: MsgBox WebBrowser3.Document.getElementsByTagName("table").Item(0).cells.Length 3- كود حساب عدد الصفوف في الجدول: MsgBox WebBrowser3.Document.getElementsByTagName("table").Item(0).rows.Length 4- كود استخراج بيانات خلية في الجدول: MsgBox WebBrowser3.Document.getElementsByTagName("table").Item(0).rows(1).cells(1).innerText 5- كود ارسال بيانات إلى خلية في الجدول: WebBrowser3.Document.getElementsByTagName("table").Item(0).rows(5).cells(0).innerText = "salah" ملاحظة: المقصود بـ item(0) i هو الجدول الأول الأزرار داخل الإطار الأحمر هي الخاصة بأكواد هذا الدرس قبل البدئ إضغط على زر فتح صفحة التجربة لفتح الصفحة أمامك webbroser.rar

جرب هذا الكود تم تغيير اسماء الشيتات الى اللغة الاجنبية لسهولة التعامل مع الكود من حيث النسخ واللصق Option Explicit Private Sub Worksheet_Activate() FIL_CDATA_VAL End Sub '++++++++++++++++++++++++++++++++++++++++++++++++ Sub FIL_CDATA_VAL() Dim i As Long: i = 8 Dim DIC As Object Set DIC = CreateObject("Scripting.Dictionary") Do Until Sheets("DATA").Range("C" & i) = vbNullString DIC(Sheets("DATA").Range("C" & i).Value) = "" i = i + 1 Loop With Sheets("RESULT").Range("k5").Validation .Delete .Add 3, Formula1:=Join(DIC.KEYS, ",") End With Set DIC = Nothing End Sub '++++++++++++++++++++++++++++++++++++++++ Sub GET_CERTIFICAT() Dim dat As Worksheet, RES As Worksheet Dim Num%, k%, R, i%, Found_Ro%, Ro%: Ro = 8 Dim FOUND_RG As Range Dim n: n = 3 Dim arr Set dat = Sheets("DATA"): Set RES = Sheets("RESULT") Union(RES.Range("c5"), RES.Range("c19"), RES.Range("c33")) = vbNullString Union(RES.Range("c8:k9"), RES.Range("c22:k23"), RES.Range("c36:k37")) = vbNullString Num = RES.Range("K5") arr = Array(2, 5, 7, 9, 11, 13, 15, 17, 19, 21) For k = 1 To n Set FOUND_RG = dat.Range("a8").CurrentRegion.Columns(3). _ Find(Num, LOOKAT:=1) If FOUND_RG Is Nothing Then Exit Sub R = FOUND_RG.Row RES.Cells(Ro - 3, 3) = dat.Cells(R, arr(0)) For i = 1 To UBound(arr) With RES.Cells(Ro, 3).Offset(, i - 1) .Value = dat.Cells(R, arr(i)) .Offset(1) = dat.Cells(R, arr(i) + 1) End With Next RES.Cells(Ro + 2, 3) = dat.Cells(R, 23) Num = Num + 1: Ro = Ro + 14 Next End Sub الملف مرفق RESULT.xlsm

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

أبدأ بحمد الله أولا وأخيرا على ما انعم ووفق وأصلي واسلم على الرحمة المهداة والسراج المنير نبينا محمد وعلى آله وصحبه وسلم ... وبعد في أحدي الموضوعات علي منتدانا الكريم وفي موضوع لاحد الأخوة بطلب برنامج ليتمكن من ادارة الأشتراكات الشهرية (اشتراكات DSL - كروت - توزيع شبكات انترنت او شبكات الكابل التلفزيوني ) وما الي ذلك من الاشتراكات التي تحتاج لمتابعة شهرية علي انتهاء صلاحية اسم المستخدم مثلا او متابعة حركة السداد المختلفة لذلك وفقني الله سبحانه وتعالي لتلك الفكرة بعمل برنامج يقوم بمتابعة تلك الاشتراكات الشهرية ومتابعة سداد وعمل وطباعة تقارير عن المديونية والمبيعات وكشف حساب للعميل وما الي ذلك من العمليات التي يمكن ان يحتاجها المستخدم لادارتها وكذلك ادخال اغلبية البيانات تلقائيا كرقم ايصال السداد مسلسل العميل تاريخ نهاية الاشتراك وادعو الله سبحانه وتعالي ان اكون وفقت في البرنامج وان يكون فيه النفع ويمكن تطويع البرنامج ليتلائم مع ادارة المشروعات الفردية الصغيرة ايضا ولا تنسونا من دعوة صالحة في ظهر الغيب بصلاح الحال ناتي لشرح بعض خصائص البرنامج المختلفة أترككم لتجربة البرنامج في المرفقات وارحب بمشاركتكم في اجراء اية تعديلات وفقنا الله واياكم للصالحات مع تحياتي // ضاحي الغريب Manage Subscriptions By Dahy al Gharieb.rar

تفضل أخى =IFERROR(MID($A2,LEN($A2)-(COLUMNS($B2:B2)-1),1),0)+0 ويمكن إستخدام هذا الكود أيضا Sub SplitNumbers() 'gamal abd elsameh 28/8/2014 'http://www.officena.net Dim WRng As Range Dim Cell As Range Dim Lgth As Byte Dim i As Byte 'Exit if worksheet not active If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 'Set range to work with With ActiveSheet Set WRng = Intersect(.Columns("A"), .UsedRange) End With 'Loop through cells and 'split the characters... For Each Cell In WRng Lgth = Len(Cell.Value) If Lgth > 0 Then For i = 1 To Lgth Cell.Offset(0, i).Value = Mid(Cell.Value, i, 1) Next i End If Next Cell End Sub تقبل تحياتى فصل أرقام بطريقة عكسية.rar

الأستاذ / وائل البسطي السلام عليكم ورحمة الله وبركاته إليك الملف به المطلوب. الرقم القومي.rar