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

Calendar.mdb

السلام عليكم ورحمة الله تعالى وبركاته الجزء الاول من صلاحيات دخول المستخدمين الى البرنامج فى هذا الجزء - فى حالة عدم وجود مستخدم مسجل اى عند فتح القاعدة للمرة الأولى يتم انشاء المستخدم الأدمن اليا يا سلام يا سلام -البيانات فى الجداول مشفرة << -----------< تلبية ورغبة لطلب احبائى الكرام -تم إخفاء معظم كائنات قاعدة البيانات التى تخص دخول المستخدمين -نموذج الدخول يمكن من خلاله تسجيل مستخدم جديد فى انتظار الادمن للموافقة عليه وتصنيفه تبعا لمجموهة الصلاحيات << -----------< الادمن كده هيستريح الله الله الله -نموذج الدخول يمكن من خلاله استرجاع كلمة المرور فى حالة النسيان ولكن بعد ادخال بيانات التسجيل الصحيحة ( اسم الدخول - الاسم الرباعى - الايميل- سؤال الامان - اجابة السؤال) -امكانية كشف نجوم كلمة المرور ما تيجو نشوف كده قد يكون هناك اخطاء سهوا منى وقد تكون هناك لدى احد اساتذتى الكرام واحبائى فكرة افضل يسعدنى تلقى مقترحاتكم حول المرفق القاعدة مطروحة للتجربة ـــــــــــــــــــــــــــــــــــــــــــــ SecurityLevel group.accdb SecurityLevel group.mdb

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

انصحك باستعمال هذا الملف الذي وضعته للمدرسة عندي Works_Days.xlsm

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

جرب هذا الكود البيانات كثيرة عندك كان يحب رفع نموذج عن الملف ولبي الملف بكامله (لمعرفة كيفية عمل الكود بشكل مريح) Option Explicit Sub give_uniques() Dim m%: m = 6 Dim Ro_wared%, Ro_Mons% Dim wared As Worksheet: Set wared = Sheets("وارد") Dim Mons As Worksheet: Set Mons = Sheets("منصرف") Ro_wared = wared.Cells(Rows.Count, 1).End(3).Row Ro_Mons = Mons.Cells(Rows.Count, 1).End(3).Row Dim my_sh As Worksheet: Set my_sh = Sheets("salim") my_sh.Range("a6:f5000").ClearContents my_sh.Range("a6:f5000").Font.ColorIndex = xlAutomatic '================================== my_sh.Cells(m, 1).Resize(Ro_wared - 4, 3).Value = _ wared.Cells(5, 1).Resize(Ro_wared - 4, 3).Value my_sh.Cells(m, 4).Resize(Ro_wared - 4, 1).Value = _ wared.Cells(5, 4).Resize(Ro_wared - 4, 1).Value my_sh.Cells(m, 6).Resize(Ro_wared - 4, 1).Value = _ wared.Cells(5, 5).Resize(Ro_wared - 4, 1).Value my_sh.Cells(m, 1).Resize(Ro_wared - 4, 6).Font.ColorIndex = 3 m = Ro_wared + 3 '====================================== my_sh.Cells(m, 1).Resize(Ro_Mons - 4, 3).Value = _ Mons.Cells(5, 1).Resize(Ro_Mons - 4, 3).Value my_sh.Cells(m, 5).Resize(Ro_wared - 4, 1).Value = _ Mons.Cells(5, 4).Resize(Ro_Mons - 4, 1).Value my_sh.Cells(m, 6).Resize(Ro_Mons - 4, 1).Value = _ Mons.Cells(5, 5).Resize(Ro_Mons - 4, 1).Value End Sub الملف مرفق alex_Wared.xlsx

أ/ishak19 إهدا علينا الله يكرمك حضرتك سألت السؤال وفى نفس اللحظة تقريبا رد عليك أستاذنا ابا جودى المنتدى ده مجموعة من الإخوة المحترفون والمبرمجون والهواه تربطهم علاقة حب المعرفة وتعليمها .. وعلى حسب وقتهم وإستطاعتهم يجيبون عن إستفساراتنا .. فكن صبوراً أخى الكريم .. ابا جودى أعطاك فكرة طبقها أنت كما تريد على برنامجك الذى لم تتفضل وترفقه كى يتم التعديل عليه. وعموما أرفق لك مثالا آخر أرجو أن أكون قد فهمت ما تريد. الرقم_الأكبر.zip

بعد اذن اخي مصطفى لا ضرورة لنبحث في العامود صفاً بعد صف عن رقم معين من خلال استعمال الحلقات التكرارية المرهقة للبرنامح (خاصة اذا كان هناك المئات او الالوف من الصفوف) يوجد طريقة اخرى من خلال الدالة المميزة Find التي تنبش المعلومة اينما كانت (وتضع بدها على الجرح مباشرة ---كما يقول المثل) وتملك خاصية ( النبش) مئات المرات دون كلل او ملل الكود Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$G$3" And Target.Count = 1 Then Get_Data End If Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++++++ Sub Get_Data() Dim ws As Worksheet: Set ws = Sheets("البيانات") Dim sh As Worksheet: Set sh = Sheets("البحث") sh.Range("a6").CurrentRegion.Offset(2).ClearContents Dim My_Number: My_Number = sh.Range("g3") Dim But_Rg As Range: Set But_Rg = ws.Range("a2").CurrentRegion.Columns(2) Dim ro%, fixed_ro% Dim m%: m = 7 Dim Search_Rg As Range Set Search_Rg = But_Rg.Find(My_Number) If Not Search_Rg Is Nothing Then ro = Search_Rg.Row: fixed_ro = ro Do sh.Cells(m, 1).Resize(, 10).Value = ws.Cells(ro, 1).Resize(, 10).Value m = m + 1 Set Search_Rg = But_Rg.FindNext(Search_Rg) ro = Search_Rg.Row If ro = fixed_ro Then Exit Do Loop Else MsgBox "No Data" End If End Sub Search_by Find.xlsm

جرب هذا التعديل ComboBox With Drop List_new.xlsm

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

ممكن تجربة التعديل على الكود الأخير الذي وضعه أستاذنا الفاضل سليم ComboBox With Drop List_new.xlsm

تفضل الكود خلف زر الأمر يصبح بهذا الشكل: Dim reportName As String Dim fileName As String Dim criteria As String fileName = CurrentProject.Path & "\نتيجة البحث" If Len(Dir(fileName, vbDirectory)) = 0 Then MkDir (fileName) ' إنشاء مجلد بالمسار المحدد End If reportName = "ResultPrint" fileName = fileName & "\" & reportName & ".pdf" 'criteria = "SomeTextField = 'ABC' AND SomeNumberField = 123" DoCmd.OpenReport reportName, acViewPreview, , criteria, acHidden DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, fileName DoCmd.Close acReport, reportName, acSaveNo

وهنـــــــا

بارك الله بك, لو تضمن المرفق التاريخ الهجري لكانت الفائدة اكبر.

اتفضل الباس ورد 1 وصلحت لك نموذج الدخول وعملت لك استعلام لفك التشفير بس نصيخة انا واجهت مشاكل مع خوارزمية التشفير دى ان مهتم بموضوع الصلاحيات هاقولك سر ولا تحكى لحد تابع الموضوع ده New Microsoft Access Database.rar

بعد اذن اخي مصطفى حل اخر بواسطة الكود Option Explicit Sub get_missing_date() Dim my_min#, my_max# Dim cel As Range Dim Col As Object Dim i#, m%: m = 2 Range("G2:G" & Rows.Count).ClearContents Set Col = CreateObject("System.Collections.Arraylist") With Col For Each cel In Range("B2", Range("b1").End(4)) cel.Value = CDate(cel.Value) cel.NumberFormat = "d/m/yyyy" .Add CLng(cel.Value) Next: .Sort End With my_min = Application.Min(Range("B2", Range("b1").End(4))) my_max = Application.Max(Range("B2", Range("b1").End(4))) For i = my_min + 1 To my_max - 1 If (IsError(Application.Match(i, Col.toarray, 0))) _ Then Cells(m, "g") = i: m = m + 1 Next Col.Clear: Set Col = Nothing End Sub الملف مرفق Missing Dates.xlsm

هنا نفس الفكرة ويمكن اختصار مشاركة الاستاذ عصام كالتالي وكتعبير في المربع المراد به النتيجة =IIf([t1]>[t2] And [t1]>[t3],[t1],IIf([t2]>[t1] And [t2]>[t3],[t2],[t3])) بالتوفيق

انا تفضلى .. ينفع كده .. يعنى مش واخد بالك من الشنب وانظارة .. طب مش لاعب

جزاك الله خيراً أستاذى

تفضل .. ولكن لا تعدل البيان فكلما عدلته سيتغير التاريخ لتاريخ اليوم 1.zip

ولو أنى كنت أفضل أن تحاول .. لكن تفضل alziraeia.zip

الحمد لله رب العالمين الحمد لله الذى تتم بنعمته الصالحات سبحانك اللهم لا علم لنا الا ما علمتنا يارب لك الحمد حمدا كثيرا طيبا طاهر مباركا يارب لك الحمد كما ينبغى لجلال وجهك ولعظيم سلطانك

لم يكن هناك أي خطأ في الكود بل الخطأ في البرمجة أنت وضعت الكود : [Forms]![مبيعات]![الكمية المتوفرة] = [Forms]![مبيعات]![الكمية المتوفرة] - [Forms]![مبيعات]![t2] و هذا الكود معناه أنقص العدد الموجود في مربع النص t2 من الكمية المتوفرة مثلا: الكمية المتوفرة 100 و الكمية المباعة 10 عند تعديلها إلى 20 يقوم الكود بالعملية التالية : 100-20=80 و هذا خطأ يجب إضافة الكمية القديمة إلى الكمية المتوفرة ثم نقوم بالعملية. لذلك وضعت متغير x_qeuntitie يأخذ قيمة الكمية المباعة قبل التعديل عليها و عدلت على الكود كالتالي: [Forms]![مبيعات]![الكمية المتوفرة] = [Forms]![مبيعات]![الكمية المتوفرة] + x_qeuntitie - [Forms]![مبيعات]![t2]

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

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

لا فض فوك يا شيخ

أحسنت أستاذ سليم عمل ممتاز بارك الله فيك وجعله في ميزان حسناتك يظهر استاذى الكريم نسيت وضع الكود داخل الملف

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

الله عليك استاذ سليم والله مبدع جزاكم الله خير الجزاء

فتح بعد التصدير Officna 3.zip بص إشتغل على الآخر مرفق بعتهولك وشوف الفرز شغال ولا لأ أصله شغال عندى تمام .. أى إضافات خارجية ضفها للجداول دى علشان بدور على أبى مش لاقى

حبيبى يابو الصلح .. معلش اتأخرت عليك حبتين لى ملحوظة حاول تشتغل على قاعدة واحدة علشان التعديلات والتحديثات متروحش ونرجع نقول راحت ليه.. بمعنى الملف اللى هتبعته هشتغل عليه وابعتهولك تعدل عليه نفسه.. يعنى احنا وصلنا لـ4 Officna وبعدين القيك مرجعن لـ Officna 3 معن إن 4 غير 3 .. تانى حاجة مش هنعمل لكل حقل نموذج بحث لوحده كده مش هتخلص. إشكال بسيط وهو توقف قائمة الفرز عن العمل ولا أدري لماذا راجعت الكود حته حته ولم اجد خطأ الصورة دى اللى اقصده تفضل أستاذنا صالح حمادي بتعديل الكود كان كل ماعليك كوبى وبست تحت زر البى دى إف.. مش إحنا قولنا نحاول عشان ماننساش. وعلى فكرة القاعدة مفيهاش حد من المؤلفين يبدأ ب أبى اليك المرفق وبلغنى بالنتيجة تحياتى Officna 3.rar

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

تفضل أخى .. إفتح تقرير Query1 مخازن.zip

اللهمَّ إنكَ أعطيتني خير الإخوان في الدنيا، فلا تحرمني صحبتهم في الاخرة، اللهمَّ أسعدهم، وفرج همهُم، وحقق آمالهم، واجعل الجنة دارهم وقرارهم، واشفهم من كلِ مرضٍ يارب، واجمعني بهم في جناتِ النعيم.

تفضل العملاء 2019.xlsm

تم معالجة الامر بالتعديل على الكود Option Explicit Private Sub ComboBox1_Change() fill_val_list If Sheets("Drop List").Range("b10") = vbNullString Then Exit Sub End If End Sub '=============================================== Sub fill_val_list() Dim my_rg As Range Dim i% Dim st$: st = Sheets("Drop List").[b8] Dim arr Application.EnableEvents = False Sheets("Drop List").Range("b10").Validation.Delete On Error GoTo No_Items Set my_rg = ActiveWorkbook.Names(st).RefersToRange ReDim arr(1 To my_rg.Cells.Count) With Sheets("Drop List").Range("b10").Validation For i = 1 To my_rg.Cells.Count arr(i) = my_rg.Cells(i) Next .Add 3, , , Join(arr, ",") End With Sheets("Drop List").Range("b10") = arr(1) Application.EnableEvents = True Exit Sub No_Items: Sheets("Drop List").Range("b10") = vbNullString Sheets("Drop List").Range("b8") = vbNullString Sheets("Drop List").Range("b10").Validation.Delete Application.EnableEvents = True End Sub '====================================== Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$B$10" And Target.Value = vbNullString Then MsgBox "Wrong range", 64 End If Application.EnableEvents = True End Sub الملف الجديد ComboBox With Drop List_new.xlsm

تفضل أخى .. عسى أن يكون المطلوب .. وفى المرة القادمة إن شاء الله وضح فى سؤالك فيما نساعدك. تحياتى fahd2.zip

السلام عليكم تفضل هذا الكود يقوم بإنشاء المجلد إن لم يجده Dim curPath As String curPath = CurrentProject.Path & "\نتيجة البحث" If Len(Dir(curPath, vbDirectory)) = 0 Then MkDir (curPath) ' إنشاء مجلد بالمسار المحدد End If

دائمًا مبدع أستاذنا الفاضل / سليم ونحن نتعلم منك الكثير بارك الله فيك ولي سؤال ماذا لو تم تعديل الكود بإضافة Range("b10") = "" في بداية الكود ليتم مسح الخلية b10 قبل البدء بالعمل فيكون الكود Option Explicit Private Sub ComboBox1_Change() fill_val_list End Sub '=============================================== Sub fill_val_list() Range("b10") = "" Dim my_rg As Range Dim i% Dim st$: st = Sheets("Drop List").[b8] Dim arr Sheets("Drop List").Range("b10").Validation.Delete On Error GoTo No_Items Set my_rg = ActiveWorkbook.Names(st).RefersToRange ReDim arr(1 To my_rg.Cells.Count) With Sheets("Drop List").Range("b10").Validation For i = 1 To my_rg.Cells.Count arr(i) = my_rg.Cells(i) Next .Add 3, , , Join(arr, ",") End With Exit Sub No_Items: ' MsgBox "Wrong range", 64 End Sub '======================================

جرب هذا الملف الكود Option Explicit Private Sub ComboBox1_Change() fill_val_list End Sub '=============================================== Sub fill_val_list() Dim my_rg As Range Dim i% Dim st$: st = Sheets("Drop List").[b8] Dim arr Sheets("Drop List").Range("b10").Validation.Delete On Error GoTo No_Items Set my_rg = ActiveWorkbook.Names(st).RefersToRange ReDim arr(1 To my_rg.Cells.Count) With Sheets("Drop List").Range("b10").Validation For i = 1 To my_rg.Cells.Count arr(i) = my_rg.Cells(i) Next .Add 3, , , Join(arr, ",") End With Exit Sub No_Items: MsgBox "Wrong range", 64 End Sub '========== ComboBox With Drop List.xlsm

ممكن يكون الرابط يفيدك

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

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

ربما كان المطلوب BASMA.xls

السلام عليكم معادلة أخي الكريم سليم مختصرة في الملف المرفق... يمكن استعمال الدالة SUMPRODUCT بدلا من الدالة SUM (وفي هذه الحالة غير ضروري تأكيدها كمعادلة صفيف)... بن علية حاجي DAYS_CALCULATION_2.xlsx

الخطأ بسيط أخى صلاح ويتلخص فى التالى استبدل strSQL = "SELECT Kaeel.IDKaeel, Kaeel.ISOName, Kaeel.KaeelFullName, Kaeel.Aboutkaeel" بـ strSQL = "SELECT Kaeel.IDKaeel, Kaeel.ISOName, Kaeel.KaeelFullName, Kaeel.Aboutkaeel" _ & " FROM Kaeel WHERE (" فى الحدثين الخاصين بهما وكذلك إستبدل DoCmd.OpenForm "frm_Kaeel", , , "[IDKeel]=" & Me.IDBook & "'" لرز Open على النموذج بـ DoCmd.OpenForm "frm_kaeel", acNormal, "", "[IDKaeel]=" & [IDKaeel], , acNormal وكذلك قم بتغيير إسم حقل القائل من TitleBook الى ISOName ولتعلم أخى الفاضل أنه لا يحك جلدك مثل ظفرك .. اعجبنى أنك حاولت وليس عيبا إن أخطأت فلكل منا عثراته .. واليك المرفق بعد التعديل ولكن حاول أنت أولا. غير فى شكل النموذج بما تحبه أنت وما يتلائم مع عملك تحياتى Officna - 1.accdb

جرب هذا الكود Option Explicit Sub creat_shett() Dim i%, t, m% Dim x%: x = Application.CountA(Sheets("Principal").Range("A:A")) + 1 For i = 3 To x t = Sheets("Principal").Range("a" & i) On Error Resume Next m = Len(Sheets(t).Name) On Error GoTo 0 If m = 0 Then '===========================================================' Sheets("Main").Copy After:=Sheets(Sheets.Count) With ActiveSheet .Name = Sheets("Principal").Range("a" & i) .Range("a1") = .Name End With '===========================================================' End If m = 0 Next Sheets("Principal").Select End Sub الملف مرفق مسحوبات.xlsm

جرب هذا الملف B2 اختر سماء من القائمة المنسدلة(المطاطة) في الخلية salim كشف بودرة.xlsm

السلام عليكم ورحمة الله تعالى وبركاته واجهت مشكلة كبيرة عند حساب الايام بين تاريخين تاريخ البدء وتاريخ الانتهاء على سبيل المثال وكان ما يهمنى هو عدم احتساب الجمعة والسبت ضمن هذين التاريخين على اعتبار انهم عطلة اسبوعية ثم خطر ببالى كذلك عدم احتساب الاعياد والمناسبات الرسمية بحثت وظللت ابحث وسهرت ولم انم منذ الأمس بسبب هذه المعضلة ولكن لم اجد اى حل فى اى منتدى حتى تفضل على الاستاذ ابو خليل جزاه الله عنا كل الخير ان شاء الله ولكن بصراحة هذا الحل لم يرضى طموحى فذهبت للبحث مرة اخرىووجدت فى موقع مايكروسوفت هذا الحل الذى أحدث خطأ فنجم عنه خلل فى الحسابات وحاولت فهم الية العمل وظللت اجرب واحاول وأخيرا بفضل الله سبحانه وتعالى الذى هدانا لهذا وما كنا لنهتدى لولا ان هدانا الله عزوجل توصلت لحل وقمت بتجربته مرار وتكرارا وبعد أن تأكدت من صحة ودقة معالجة البيانات قررت ان ارفعه على هذا الصرح الشامخ ملاحظة يمكن الاستفاده من هذا المرفق فى الاتى 1- حساب ايام العمل الفعليه بدون ايام الاجازات الرسمية والعطلة الاسبوعية --- العطلة الأسبوعية بالنسبه لى انا كانت الجمعهة والسبت ممكن تعديلها ☺ 2- حساب الاجازة التى تخصم من الرصيد فيستثنى منها ايام الاجازات الرسمية والعطل الاسبوعية كذلك للعلم تعدل بيانات الاجازات الرسمية والتواريخ من خلال القاعدة طبقا لكل دولة حتى لا يتم احتساب هذه التواريخ أحبكم فى الله وانتظر ردكم بعد التجربة ActualDaysCalcult.rar

وعليكم السلام أخي حسين الكود والطريقة صحيحة ، ولكني عدلت على التقرير قليلا ، فما ادري اذا بيصلح الوضع ملئت الجدول ببعض البيانات . وشغلت التقرير يدويا . والنتيجة . هذا معناه ان التقرير يشتغل بصورة صحيحة ، ويمكن طباعته مباشرة بكل البيانات مرة واحدة!! جرب المرفق واخبرني جعفر 272.2.BARCODE22.accdb.zip