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

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

بعد اذن المكتبة طبعاٌ تحسين بسيط على الكود لنحصل على نطاق اكبر Private Sub TextBox1_Change() On Error Resume Next If ActiveSheet.AutoFilterMode = True Then: ActiveSheet.ShowAllData If (Me.TextBox1.Value) = "" Then: ActiveSheet.AutoFilterMode = False: GoTo 1 Range("B6:K" & Cells(Rows.Count, "k").End(3).Row).AutoFilter Field:=1, Criteria1:="=*" & TextBox1.Text & "*", Operator:=xlAnd Exit Sub 1: End Sub

حياك الله On Error GoTo 5 يمكّن برنامج معالجة الأخطاء وينتقل بالإجراء إلى السطر المحدد . يعنى اسم سطر أو رقم السطر. ففي حالة حدوث خطأ في وقت التشغيل سيتم الانتقال إلى السطر المحدد ولكن يجب أن يكون السطر المحدد في نفس الإجراء On Error GoTo 0 يعطل معالج الخطأ الذي تم تمكينه في الإجراء الحالي ويعيد تعيينه إلى Nothing. (لا شي) عندما تجرب ستفهم أكثر On Error Resume Next يحدد أن عند حدوث خطأ في وقت التشغيل، ينتقل عنصر التحكم إلى العبارة التي تلي العبارة التي حدث عندها الخطأ مباشرة، و متابعة التنفيذ من تلك النقطة. أخي العزيز : الشرح يطول وبالتجربة ستفهم كل هذه الأشياء إذا لم تستطع معالجة رسالة الخطأ ارفق الملف هنا ليتم معالجتة وحل المشكلة تحياتي

الاخ محمود الشريف شكرا لك ولجميع الزملاء اليك واجهة للشيت يمكن ربط البيانات منها شيت المرحلة الابتدائية.rar

السلام عليكم ورحمة الله وبركاته في الواقع صار لي حوالي الشهر اشتغل على هذه الهدية ، ولكني وللأسف لم انتهي منها الى الآن (باقي القليل والحمدلله) ، ولكن ولأن عندنا مناسبة غالية هذه الليلة ، فأحببت ان اكتب الموضوع ، واهديه الى صاحب المناسبة العمل اللي يقوم به البرنامج: سأترككم مع هذه الصور من النماذج ، وبعض صفحات المواقع التي جربت العمل عليها: . . . وللحديث تتمة ان شاء الله جعفر

السلام عليكم ،، أقدم لكم هذا الفورم (يرجى الانتظار...) مع رسائل تذكيرية أرجوا أن تحملوه وتشاهدوه وتعطوني رأيكم المثال في الملف المرفق.. db1.zip

اولا احب ان اشكر كل اعضاء و مشرفى هذا المنتدى العظيم الذى تعلمت و لازلت اتعلم منه الكثير و الكثير و اليوم اقدم الى الجميع برنامج المخزون الشامل حيث قد طلب منى احد الاصدقاء برنامج لضبط حركه مخزون شركته وهى شركه مستحضرات تجميل فقد قمت بعمل هذا البرنامج الذى يصلح لكل انواع المخزون مع بعض التعديلات البسيطه نبذه صغيره عن البرنامج 1-برنامج يحتوى على صفحه فواتير المبيعات و المشتريات و المرتجعات 2-و يحتوى على صفحه كشف حسب العملاء التى توضح المدفوع و المستحق خلال فترات معينه 3- صفحه التقارير وتضم حركه الاصناف حركه الفواتير وتقرير شامل بالمبيعات و المشتريات خلال اى فتره انت تحددها 4- كما يمكنك ادخال اى سند سواء كان صرف او قبض من خلال فورم ادخال السندات 5- حركه المخزون و التى توضح الربح و الخساره لكل صنف على حده و المزيد و المزيد من المزايا الاخرى التى سوف تكتشفها بنفسك ملاحظات تم عمل البرنامج على اكسيل2010 وتم تجربته بنجاح على اكسيل 2010 الرقم السرى للدخول الى البرنامج هو 123 وانصح جميع الاخوه الذين يجربون البرنامج ان يتم تجريبه على نفس الاصدار تجنبا لحدوث اى مشاكل تم رفع البرنامج على موقع الميديا فير حيث ان حجم البرنامج 2 ميجا بايت كما ارحب براى الاخوه و الخبراء فى البرنامج سواء كان نصيحه او نقد او معلومه جديده كما انوه باننى جاهز لاى استفسار او تعديل لهذا البرنامج لمن يريد على حسب طبيعه عمله و على حسب وفت فراغى و اخيرا اشكر كل اعضاء ومشرفى هذا الصرح العظيم الذى تعلمت منه التحميل من الرابط التالى http://www.mediafire.com/file/u34hp2c38h6slc7/برنامج المخزون الشامل.rar برنامج المخزون الشامل.rar

السلام عليكم جرب هذه المحاولة Emp2.rar

الظاهر هكذا !! بس لوسمحتي تأخذين صورة للشاشة وارسليها ، يمكن اعدادات تنسيق التاريخ عندك نظام امريكي ، يعني الشهر / اليوم / السنة ، والمشكلة هاي ما تبين إلا في التواريخ الاكبر من 12 !! ولكن ومثل ما تفضلتي ، غيري تنسيق التاريخ في جهازك واخبريني التجربة. ولكن ، رجاء تجربي هذا المرفق اولا وقبل تغيير اي شئ جعفر 566.1.Employees.mdb.zip

أختي الظاهر انك بحثتي بالتاريخ فقط!! على العموم ، هذا الكود المعدل يعمل للبحثين معا ، او اي بحث مستقل (الحقول او التاريخ): Private Sub بحث_Click() On Error Resume Next Dim ctl As Control Dim Argcount As Integer Dim str As String Argcount = 0 MyCriteria = "" For Each ctl In Me.Controls If (ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox) And ctl.Tag <> "" Then If ctl.Name <> "Date_From" And ctl.Name <> "Date_To" Then AddToWhere ctl.Tag, ctl.Value, "[" & ctl.Name & "]", MyCriteria, Argcount End If End If Next ctl If Len(Me.Date_From & "") <> 0 And Len(Me.Date_To & "") <> 0 Then If Len(MyCriteria & "") <> 0 Then MyCriteria = MyCriteria & " And " End If MyCriteria = MyCriteria & " [Date_BR] between #" & Me.Date_From & "# And #" & Me.Date_To & "#" End If 'Debug.Print MyCriteria myStr = "select * from S_NAMES where " & MyCriteria Me.S_NAME.Form.RecordSource = myStr Me.Requery End Sub جعفر 566.Employees.mdb.zip

السلام عليكم اخي أبونادر البحث السابق كان لجميع الحقول ، والبحث الجديد يجب ان يكون لجميع الحقول و بين التاريخين ، والظاهر انك نسيت البحث في الحقول ، وعملت البحث بين تاريخين فقط جعفر

تاريخ ام القرى هو تاريخ هجري قمري ولكن تاريخ هجري اكسس معدل ليتواءم مع الميلادي للعلم ،،،

وعليكم السلام اختي كود البحث اصبح: Private Sub بحث_Click() On Error Resume Next Dim ctl As Control Dim Argcount As Integer Dim str As String Argcount = 0 MyCriteria = "" For Each ctl In Me.Controls If (ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Or ctl.ControlType = acCheckBox) And ctl.Tag <> "" Then If ctl.Name <> "Date_From" And ctl.Name <> "Date_To" Then AddToWhere ctl.Tag, ctl.Value, "[" & ctl.Name & "]", MyCriteria, Argcount End If End If Next ctl If Len(Me.Date_From & "") <> 0 And Len(Me.Date_To & "") <> 0 Then MyCriteria = MyCriteria & " And [Date_BR] between #" & Me.Date_From & "# And #" & Me.Date_To & "#" End If 'Debug.Print MyCriteria myStr = "select * from S_NAMES where " & MyCriteria Me.S_NAME.Form.RecordSource = myStr Me.Requery End Sub . جعفر 566.Employees.mdb.zip

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

تفضل لعله المطلوب عدم تكرار.rar

الاخوه الافاضل تنوع جميل بوركتم جميعا تقبلو تحياتى

أخى الكريم الأستاذ // محمد الدسوقى إليكم ما طلبتم توجد معادلة بأول سطر بالشهادة مرتبطه بالدرجات وتم إضافة الطباعه لنصف العام وآخر العام وتم ربط المعادلات بالقائمة المنسدلة لتتغير النتائج تجد عدد الناجحين مختلفين وكذلك الراسبين حتى تشاهد وتتأكد بتغير النتائج All Certificates print_ FORM OR ALL OR PDF _By _MZMELSHRIEF+PR_N_R_H_L.rar

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

وعليكم السلام هناك عدة اسباب: منها: iif ، وحسب الدرس التالي: عيوبها: الدالة تختبر جميع الحالات ، ولا تختبر القيمة الاولى وتخرج (مثل الـ IF) وارى هنا انك تستعمل iif ستة مرات ، ولثلاثة حقول: . وهذا سبب آخر: . وفهرست الحقول في الجدول ، تلك التي تستخدمها كمعيار في الاستعلام ، وانت عندك الكثير منها في المثال اعلاه. وطبعا يكون في العديد من الاسباب الاخرى ، ونستطيع معرفتها بفحص البرنامج بدقة جعفر

السلام عليكم ورحمة الله وبركاته الاخوه الافاضل بناء على طلب احد الاعضاء الاخ طاهر محمد على الرابط الاتى http://www.officena.net/ib/index.php?showtopic=54367&page=1 تم عمل نموذج لفاتوره بدون فورم حيث يمكنك التسجيل والتعديل والحزف دون الجاجه الى وجود فورم اردت فقط ان ارفع الملف فى موضوع جديد لتعم الاستفاده على من يريد تقبلو تحياتى نموزج فاتورة بدون فورم نهائى.rar

مكتبة ريم تحياتى و جزاك الله خيرا

تفضل أخ خالد ستار Data base3.rar

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

علشان نقدر نقرأ المعادلة ، ففكتها لمعرفة اماكن الحقول الى: A1 = "[امتار الإنتاج]" A2 = "امر التشغيل" A3 = "لوحة تحكم" A4 = "تاريخ الصب" A5 = "المنتج" A6 = "نوع" Me.n1 = DSum("[A1]", "A2", "[A6]=[FORMS]![A3]![M] AND [A5]=[FORMS]![A3]![B2] AND [A4]=[FORMS]![A3]![MM]") . وانا استغرب اذا كانت المعادلة تشتغل اصلا ، لأن طريقتها غير صحيحة!! الآن السوال: الحقول M و B2 و MM اي منها نص ، واي منها رقم ؟ جعفر

أخى الكريم بوركتم وجزيتم خيرا

بسم الله الرحمن الرحيم وجدت كثيرا من الاعضاء تطلب هذا الموضوع كثيرا وعندما وضعت مثال لشاشة دخول بكلمة مرورظهر ليا مشرف كدا كالعادة وقالي البوقين دول كنت أفضل يكون في موضوع مستقل لأن المشاركات الفرعية تندثر مع الوقت لما تلاقي نفسك عملت ملف مميز زي كدا .. افتح موضوع جديد واشرح بالتفصيل (مش ترمي الملف وتجري ..) وبعد كدا في المشاركة الفرعية تضع رابط للموضوع ليستفيد أكبر عدد من الأعضاء إذ أن المتابعين للمشاركات قلة .. ولكن هناك كثر في انتظار الموضوعات الجديدة للتعلم والاستفادة .. متنساش كلامي يا سكر زيادة وانا حبيت اوجه له رسالة من هنا واقول له انا بحب الشاي سكر خفيف المهم حبيبي الغالي فعلا صدق في كلامه فا نخش في الموضوع وبلاش رغي بقي اولا نفتح بقي ملف اكسيل جديد ونخش محرر الاكواد ونعمل يوزر فورم جديد ونقوم بوضع عدد واحد ليبل عشان نتكب فيها كلمة المرور او رمز الحماية او أي حاجه في أي حاجه اثنين تكست بوكس الاول لكتابة المستخدم داخلها كلمة المرور اللي هيكتبها عند الدخول الثاني مش مهم لينا كل لزمته انه كل ما المستخدم يحط رقم غلط يزود فيه رقم لحد لما يوصل للرقم المحدد لاغلاق البرنامج وتظهر رسالة تقوله GAME OVER بمعني انه استنفذ كل المحاولات وجاري اغلاق البرنامج وواحد كومند زرار يعني عشان ندوس عليه للدخول ز ما احنا شايفين وطبعا متنسوش تحطه خلفيه حلوة كدا للفورم دا اهم حاجه عندي اه كله الا الجماليات وموضوع الجماليات دا نعمله موضوع قريب ان شاء الله بس تكون عندكو لسعه فوتوشوب بس وطبعا نخلي الخلفية علي وضع الاسترتش اه يعني الصورة تبقي لازقه في الفورم كيبر تكبر معاه يصغر تصغر معاه تمام كلنا عارفين الاسترتش كويس زي ما احنا شايفين نيجي بقي للاكواد اول كود نحطه في الجينرال بقي اول حاجه Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "User32" (ByVal hWnd As Long) As Long Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Const WS_SYSMENU = &H80000 والكود التاني في حدث تهيئة اليوزر فورم Private Sub UserForm_Initialize() Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindow(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) End Sub toolwindowودول لزوم الفشخرة والمنظره وعشان نقصقص البتاعه دي ويضفي جمالا للفورمة هي الخيارات بتاعتها متاحه في الفيجوال بيسك عادي زي كدا ننفض للحته دي نخش علي الكود اثالث ودا هيبقي في تنشيط اليوزر فورم Private Sub UserForm_Activate() Application.WindowState = xlMaximized With Me .Height = Application.Height .Width = Application.Width .Left = Application.Left .Top = Application.Top End With End Sub ايه الكلام دا دا ياسيدي بنقوله كبر لنا البرنامج ملئ الشاشة Maximized لما تفتح اليوزر فورم زي الشاطر خلي مقاسات اليوزر فورم زي مقاسات البرنامج واحنا مكبرين شاشة البرنامج يبقي كدا اليوزر فورم هيبقى كبير زي البرنامج تمام كدا الكود الرابع Private Sub CommandButton1_Click() If TextBox1.Text = "123" Then Me.Hide Else am = am + 1 MsgBox " لقد استخدمت " & am & " محاولة من اصل 5 محاولات, vbCritical, "elmalak_elhazen_yasser@yahoo.com" If am = 5 Then MsgBox "لقد استنفذت جميع المحاولات" ActiveWorkbook.Save ActiveWorkbook.Close End If End If End Sub اكيد دماغكو لفت معايا معلش انا شرحي علي قده استحملوني دا كود بيقول اذا كانت التكست بوكس واحد بتساوي 123 اذن ياعم اخفيني من وشك ويظهر معاك ملف الاكسيل عادي طيب اذا ما حصلشي بقي نعمل ايه تعالا بقي am دي اسم التكست بوكس اتنين بس انا غيرته الى am ندوس علي التكست بوكس اتنين ونغيره من هنا ومننساش نخفى التكست بوكس دا من هنا واحد فكيك بقي يقول ليه am اقوله ياناصح دول اول حرف من اسيل واول حرف من محمد ولادي تمام يامعلم محدش يشتم ولا يضرب المهم بقي ان am بتساوي نفسها + 1 تمام اه قبل ما انسى نخلي قيمة am دي بصفر نكتب جواها صفر عشان لما يعد يعد من بعد الصفر يعني كل ما المعلم يدوس غلط يزود رقم واحد وتطلع رسالة تقوله وصلت لكام محاولة ولما يوصل للمحاولة الخامسة يقوله بالسلامة ياحبي انا هقفل وانام وتمام كدا زي الفل والكلام خدنا والدرس خلص شفتوا انتو مش مصحصحين ازاي نسينا نحط كود فتح الفورم في حدث فتح الملف Private Sub Workbook_Open() UserForm1.Show End Sub وبعدين انا مش هحط امثلة زي واحد صاحبي وحبيبي بيقول انكم لازم تتعبوا شوية وتعملوها بنفسكوا بدل ما تخدو كوبي وبست وخلاص للحديث بقية باذن الله لاستكمال اضافات تانيه اتمنى من الله ان ينفعكم هذا الشرح تقبلو تحياتي ياسر العربي قلت اضيف صورة الكود لكمعشان ميبقاش ليكو حجه

أخى الكريم الأستاذ // ناصر تم إضافة المطلوب ( طباعه الكل & طباعه ناجح & طباعة راسب ) على نفس نموذج الأستاذ // محمد All Certificates print_ FORM OR ALL OR PDF _By _MZMELSHRIEF+PR_N_R.rar

استاذى الفاضل / محمود الشريف السلام عليكم ورحمته الله وبركاته بارك الله فيكم وأحسن اليكم الان اكتشفت الخطأ وهى إضافة 1 بهذين السطرين Cells(C + 2, "B") = x Cells(C + 2, "A") = Cells(C + 1, "A").Row - 7 جعلكم الله تعالى عونا للجميع شاكر فضلكم *** وجزاكم الله خيرا

وعليكم السلام يجب عليك إضافة on error goto ...... وتعني ( في حالة حدوث خطأ اذهب إلى السطر ...... ) وتحدد السطر داخل الكود بقي أمر مهم وهو : أين تضع هذه الأضافة ؟ نضعه قبل السطر الذي يظهر الخطأ تحياتي

أخى الكريم جزيتم عنى خيرا على دعاؤكم الطيب إليكم الملف بالمرفقات استدعاء بيانات بعد التعديل.rar

اعمل اعددات كما هو موضح وستتحول جميع التواريخ الى هجري

ربنا يجازي بالخير كل من يشارك في عمل خالصا لوجه الله الكريم ثانيا مطلوب 3 صفحات في اول البرنامج يكون بالصفحه الاولى 4 ازرار فقط زر للدخول لازرار الترم الاول وزر للدخول لازرار الترم التاني وزر للدخول لازرار الدور التاني وزر لتغيير كلمه السر لشده احتياجها في اعمال الكنترول فرجاء من الجميع بوضع هذه الصفحات وساضع ايضا تصور لها عشان نختار افضلها فتكون للبرنامج =============================================== بالنسبه للدرجات التي طلبها اخي الكريم محمود ... جاري تجهيزها

جميل جدا جزاك الله خير

أخى الكريم الأستاذ // ناصر سعيد سنضيف على مثال الأستاذ // محمد الدسوقى تجد انه تم وضع فى خليه E1 عدد الطلاب كاملا سنضع بالخلية D2 كلمة ناجح وبالخلية المقابلة لها E2 عدد الناجحين يمكن ذلك سنضع فى الكود من ضمن جزئيات الثوابت خلية عدد الناجحين وخليه كلمة ناجح ونحدد نطاق الناجحين بشيت البيانات وهو العمود الذى يسجل فيه كلمه ناجح أو راسب أو دور ثان وسنضيف بالكود كود طباعه الناجحين وربطه بزر طباعه الناجحين فقط وسيكون كالتالى ' نطاق ناجح في ورقة البيانات بإفتراض أن هذا العمود المسجل بالكود هو من يحدد ناجح أو راسب ونسميه مثلا MYND Const MyND As String = "D4:D44" ' خلية عدد الناجحين Const CountNA As String = "E2" ' كلمة البحث عن الناجحين ونسميها مثلا NA_G Const NA_G As String = "ناجح" Sub الناجحين() Application.ScreenUpdating = False MZM_ClearContents With MySheet Call MZM_Test_Fill(.Range(CountNA)) If MZM_Test Then Call MZM_Nd(NA_G): .PrintPreview End With Application.ScreenUpdating = True End Sub

تفضل FL sample1.rar

فيما يختص بشرح كود طباعة الشهادة ' بدء الكود بتحديد النطاقات الثابة ' const تستخدم لتحديد الثوابت ' اسم ورقة الشهادات Const ShName As String = "Certificates" ' رقم اول صف للشهادة Const FirstRow As Integer = 6 ' عدد صفوف الشهادة Const CountRow As Integer = 17 'عدد اعمدة الشهادة التي تريد اظهارها في الطباعة Const CountColumn As Integer = 17 ' خلية موقع الطالب لمعادلات الشهادة Const Range_Index As String = "A6" ' اسم ورقة البيانات Const Sh As String = "Data" ' نطاق الاسماء في ورقة البيانات Const MyNSearch As String = "C5:C44" ' الخلية التى بها عدد كل الطلاب تجدها بشيت الشهادة Const CountAll As String = "E1" ' متغيرين نعلن عنهم Dim MZM_Test As Boolean Dim MySheet As Worksheet Sub MZM_ALL() ' إيقاف تحديث الشاشة Application.ScreenUpdating = False ' استدعاء الكود MZM_ClearContents With MySheet ' اسم النطاق الثابت المعلن عنه سابقا (Range_Index)خلية موقع الطالب لمعادلات الشهادة .Range(Range_Index).Value = 1 ' استدعاء عمل الكود التالى مع الأخذ فى الاعتبار الثابت الذى قمنا بتعريفة وهى الخلية التى عدد اجمالى الطلاب Call MZM_Test_Fill(.Range(CountAll)) ' اذا كان المتغير المعلن عنه بأول الكود به بيانات بناء على خلية معادله الشهادة تم تنفيذ المطلوب مع استدعاء الكود بالسطر السابق اذن يتم تطبيق التالي ' يتم مسح النطاق للكتابه فيه مع عرض الطباعة If MZM_Test Then .PrintPreview Else .Range(Range_Index).ClearContents End With ' اعادة تحديث الشاشة Application.ScreenUpdating = True End Sub Sub MZM_Delete() ' إيقاف تحديث الشاشة Application.ScreenUpdating = False ' استدعاء عمل الكود التالى MZM_ClearContents ' اعادة تحديث الشاشة Application.ScreenUpdating = True ' حفظ العمل واظهار رسالة تفيد ذلك ThisWorkbook.Save MsgBox "تم مسح الشهادات وحفظ نطاق عمل الشهادة الرئيسية", vbMsgBoxRight, "الحمد لله الذى بنعمته تتم الصالحات" End Sub Sub MZM_ClearContents() ' متغير نعلن عنه Dim T As Long ' تخصيص متغير أعلن عنه سابقا Set MySheet = Sheets(ShName) With MySheet ' خلية موقع الطالب لمعادلات الشهادة وهو من الثوابت المعلن عنها سابقا يتم المسح مع الحفاظ على النموذج ( الشهادة الرئيسية) الذى يستخدم للنسخ كما هو .Range(Range_Index).ClearContents T = .UsedRange.Rows.Count .Rows(FirstRow + CountRow).Resize(T).Delete ' نطلب منه الوقوف على الخلية التى تم الاعلان عنها كثابت وهى خلية موقع الطالب لمعادلات الشهادة Application.GoTo .Range(Range_Index), True End With End Sub ' الكودين التاليين يختصوا بنسخ نطاق الشهادة بما فيها من معادلات وتنسيق مع رسالة توضح اذا كان لا يوجد معادلات Sub MZM_Test_Fill(MyCel As Range) If IsNumeric(MyCel) And MyCel.Value > 0 Then MZM_Test = True If MyCel.Value <> 1 Then Call MZM_AutoFill(MyCel.Value) Else MZM_Test = False MsgBox MyCel.Offset(0, -1) & Chr(10) & Chr(10) & MyCel, 524288 + 1048576 + 16, "بيانات غير متوفرة" End If End Sub Sub MZM_AutoFill(R As Integer) Dim SourceRange As Range, fillRange As Range Dim RR As Long RR = (R * CountRow) With MySheet Set SourceRange = .Rows(FirstRow).Resize(CountRow) Set fillRange = .Rows(FirstRow).Resize(RR) SourceRange.AutoFill fillRange, xlFillDefault .PageSetup.PrintArea = .Range("B" & FirstRow).Resize(RR, CountColumn).Address End With End Sub

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

وعليكم السلام ورحمة الله وبركاته مرحبا اخي الكريم جرب الكود التالي Dim i, y, sh As Double y = 1 sh = DCount("*", "tbl1") For i = y To sh + (y - 1) DoCmd.OpenForm "FormName" Next i DoCmd.Close acForm, "FormName" DoCmd.OpenReport "ReporName", acViewPreview, "", "", acNormal ارجو ان يكون الكود واضح تحياتي يتم وضع الكود في حدث عند الفتح Private Sub Report_Open(Cancel As Integer) Dim i, y, sh As Double y = 1 sh = DCount("*", "tbl1") For i = y To sh + (y - 1) DoCmd.OpenForm "FormName" Next i DoCmd.Close acForm, "FormName" DoCmd.OpenReport "ReporName", acViewPreview, "", "", acNormal End Sub

أضف نموذج وضع كود فتح هذا النموذج قبل كود فتح التقرير ثم في حدث عند الفتح أو حدث عند التحميل للتقرير ضع كود إغلاق هذا النموذج

وعليكم السلام تفضل: Private Sub Form_ApplyFilter(Cancel As Integer, ApplyType As Integer) Dim rst As DAO.Recordset ApplyType = acShowAllRecords If Len(Me.Filter & "") = 0 Then mySQL = "Select * From " & Me.RecordSource Else mySQL = "Select * From " & Me.RecordSource & " Where " & Me.Filter End If Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst RC = rst.RecordCount Me.Engineers = 0 Me.Teachers = 0 For i = 1 To RC If rst!job = "ãåäÏÓ" Then Me.Engineers = Me.Engineers + 1 ElseIf rst!job = "ÇÓÊÇÐ" Then Me.Teachers = Me.Teachers + 1 End If rst.MoveNext Next i End Sub Private Sub Form_Current() Call Form_ApplyFilter(0, 0) End Sub Private Sub Form_Load() Me.Filter = "" Me.FilterOn = False Call Form_ApplyFilter(0, 0) End Sub . جعفر 564.db.accdb.zip

الــدرس الرابع: الجملة الشرطية ( IIF ) ( لقد قام أستاذي و أخي جعفر حفضه الله بتقديم هذا الدرس كله و أنا لم أفعل شيء سوى التنسيق و النشر فاللهم جازيه عنا خير الجزاء يا رب العالمين) طريقة استعمال ((iif: iif(expr, truepart, falsepart) iif(القيمة المطلوب تقييمها, اذا كان التقييم صح فستأخذ هذه القيمة, اذا كان التقييم خطأ فستأخذ هذه القيمة) مثال: Age=50 Age_Now = iif(Age=50 , "Yes it is", "No it is not") ميزاتها: نستطيع استعمالها في الكود ، والاستعلام نستطيع ان نضع اكثر من شرط واحد فيها مثال: Price=10 Qty=5 Sale_is= iif(Price* Qty = 50 , "Low sale", iif(Price * Qty = 100 , "Middle sale" , "Big sale")) عيوبها: الدالة تختبر جميع الحالات ، ولا تختبر القيمة الاولى وتخرج (مثل الـ IF): 1. المثال السابق ، مع ان اول تقييم هو الجواب الصحيح 10*5=50 ، إلا ان الدالة ستقوم بتقييم جميع الاختيارات ، مما يجعلها تأخذ وقت اطول للتقييم ، 2. بسبب اختبارها لجميع الحالات ، فيجب ان نكون دقيقين في وضع التقييم ، مثلا اذا اردنا اختبار قيمة مثال: Divide = iif(n2 = 0, MsgBox("القيمة صفر"), MsgBox(n1 / n2)) فاننا سنحصل على خطأ ، لأن الدالة تحققت من القيمتين ، والقيمة الثانية هي تقسيم رقم على صفر ، 3. بطيئه نوعا ما ، لأنها تحول الارقام الى Variant (رجاء مراجعة الدرس الاول للأخ صالح) ، ثم تقوم بالحساب ، 4. لا تستطيع ان تستخدم اكثر من 7 شروط في الاستعلام ، مثلا عندنا ارقام الاشهر ونريد نستخرج اسمائها ، 5. ببساطة مكن ان تخطأ في عدد الاقواس والفواصل ، 6. لا تستطيع قراءة ولا تغيير اي شئ بسهولة ، وخصوصا اذا كان عندنا اكثر من تقييم ، امثلة عملية: 1. اذا عندنا ارقام الاسبوع ، ونريد ان نستخرج ايامها ، فاذا عملنا الكود في الاستعلام مباشرة ، فسيكون صعب ، لذا ، فالطريقة التي اعملها انا هي: أ‌- عمل الكود في محرر VBA ، هكذا: لاحظ اني عملت اول شرط ونتيجة القيمة الصحيحة ، ثم انهيت السطر بخط سفلي _ (واللي معناه في البرمجة ان الكود سيتواصل في السطر التالي ، ثم انتقلت السطر التالي ، ونفس الشئ ، عملت الشرط التالي ونتيجة القيمة الصحيحة و.... كما سبق و... الى ان نوصل للسطر الاخير ، فوضعت الشرط الاخير ونتيجة القيمة الصحيحة والخطأ ، ثم حسبت كم قوس مفتوح ، فقفلت بنفس عددها: iDay = 2 Today_is = IIf(iDay = 1; "Sun"; _ IIf(iDay = 2; "Mon"; _ IIf(iDay = 3; "Tue"; _ IIf(iDay = 4; "Wed"; _ IIf(iDay = 5; "Thu"; _ IIf(iDay = 6; "Fri"; "Sat")))))) ب- والخطوة التالية ان نجعلها في سطر واحد ، حتى نأخذها للإستعلام ، وهي ان نحذف الاشارة _ ، لتكون النتيجة Today_is = IIf(iDay = 1; "Sun"; IIf(iDay = 2; "Mon"; IIf(iDay = 3; "Tue"; IIf(iDay = 4; "Wed"; IIf(iDay = 5; "Thu"; IIf(iDay = 6; "Fri"; "Sat")))))) . هكذا . 2. اذا عندنا سجلات الصف الاول والثاني ، واردنا معرفة عدد الطلاب لكل صف: iif([Section]= "A" ; 1;0) وهكذا تكون في الاستعلام: 3. اذا عندنا اكثر من 7 شروط (ارقام الاشهر نريد تحويلها الى اشهر) ، فهنا نضطر الى عمل وحدة نمطية: Function What_Month(M) Select Case M Case 1 What_Month = "Jan" Case 2 What_Month = "Feb" Case 3 What_Month = "Mar" Case 4 What_Month = "Apr" Case 5 What_Month = "May" Case 6 What_Month = "Jun" Case 7 What_Month = "Jul" Case 8 What_Month = "Aug" Case 9 What_Month = "Sep" Case 10 What_Month = "Oct" Case 11 What_Month = "Nov" Case 12 What_Month = "Dec" End Select End Function ونرسل لها ارقام الاشهر ، هكذا . والنتيجة

جرب الكود التالي Sub Copy_Selected_Range_As_New_Workbook() Dim a As Range, rng As Range Dim strDir As String Application.ScreenUpdating = False Set rng = Selection ActiveSheet.Copy If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData Columns.Hidden = False Rows.Hidden = False Cells.ClearContents For Each a In rng.SpecialCells(xlCellTypeVisible).Areas Range(a.Address).Value = a.Value Next a strDir = ThisWorkbook.Path & "\Test\" If Dir(strDir, vbDirectory) = "" Then MkDir strDir End If ActiveWorkbook.SaveAs Filename:=strDir & ThisWorkbook.Name & ".xls", FileFormat:=56, CreateBackup:=False ActiveWorkbook.Close Application.ScreenUpdating = True End Sub

أخي الكريم عبد العزيز جزيت خيراً على ردك الطيب يرجى عدم استخدام الاقتباسات الطويلة ...

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

شكرا اخى الكريم klma7lwa وبارك الله فيك واسعدنى مرورك وكلماتك الطيبه

السلام عليكم ورحمة الله وبركاته أخي / عمرو بالنسبة لصلاحيات المستخدمين عند إضافة مستخدم ويتم تحديد صلاحيات محدودة ماهي الصلاحيات التي يمكن أن يتحكم بها المستخدم لدي إقتراح وضع جميع الأيقونات ويتم عمل بجوارها علامة chek لتحديد مدي الصلاحية لإستخدام الأيقونة يارب أكون قد وصلت الفكرة آسف جدا علي الإطالة شكرا

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