اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

  1. أبوبسمله

    أبوبسمله

    الخبراء


    • نقاط

      6

    • Posts

      3,242


  2. kanory

    kanory

    الخبراء


    • نقاط

      6

    • Posts

      2,189


  3. ناصر سعيد

    ناصر سعيد

    05 عضو ذهبي


    • نقاط

      6

    • Posts

      1,963


  4. الحلبي

    الحلبي

    04 عضو فضي


    • نقاط

      5

    • Posts

      587


Popular Content

Showing content with the highest reputation on 17 ينا, 2020 in all areas

  1. جرب الكتابة داخل المربع الأول وانظر النتيجة .... ايقاف علامة جدولة.accdb
    3 points
  2. وعليكم السلام حل مؤقت الى ان يعدل احد اخواننا واساتذتنا الافاضل بشكل افضل اخى @ابو البشر موديول التفقيط موجود هو مديول واحد اساسا بامثال ولكن اعتقد يجب ان يكون هناك ارتباط اخى الفاضل لما تطلبه بعد ذلك فى ملاحظاتك الثانيه وان يكون هناك بجدول العملاء ارتباط حقول التفقيط والله اعلى واعلم تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق BoxCurrn.rar
    2 points
  3. استاذنا وخبيرنا الفاضل / @أبو عبدالله الحلوانى التوضيح الذي قمت به حضرتك كان فى منتهى الاهمية وليس هناك (بالنسبة لى) اي تطويل او تعقيد بل العكس صحيح تماما . وياريت ياريت ترسل لى على الخاص لانه اولا شرف لى ثانيا اننى احتاجه جدا فى عملى الا اذا طلب احد الاخوان ان يكون الشرح للكل او حتى في موضوع جديد . اشكرك على اهتمامك بسؤالى وربنا يجزاك خير ويزيدك الله من العلم ـ تحية خاصه لكل اهل الصعبد الذى انا منهم كل الاحترام والتقدير لك اخى الفاضل ابو عبد الله
    2 points
  4. وعليكم السلام اتفضل مثال لاحد اخواننا واساتذتنا جزاهم الله عنا كل خير ممكن تعمل فزر زى الموجود او فى حدث الحذف نفسه رتب امورك كما تريد بالتوفيق ان شاء الله اعادة الترقيم.rar
    2 points
  5. السلام عليكم جرب المعادلة التالية: * بالفرنسية : =ARRONDI.AU.MULTIPLE(8465.46;10) * بالإنجليزية : =MROUND(8465.46;10) ملاحظة : يجب أن تراعى الفاصلة المنقوطة والفاصلة في هذه المعادلات حسب النظام المعمول به...
    2 points
  6. جرب هذا الماكرو Option Explicit Sub ABSCENT() Application.Calculation = xlCalculationManual Dim K As Worksheet, A As Worksheet Dim Ro_K%, col%, Ro_A%, i%, m%, t%: t = 1 Dim ALL$, ALPHA$, Str$: Str = "غ" ALL$ = " ": ALPHA = " " Set K = Sheets("keab"): Set A = Sheets("arhkeab") Ro_K = K.Cells(Rows.Count, 2).End(3).Row If Ro_K < 5 Then Exit Sub Ro_A = A.Cells(Rows.Count, 2).End(3).Row m = IIf(Ro_A < 5, 5, Ro_A + 2) For i = 5 To Ro_K If Application.CountIf(K.Cells(i, 6).Resize(1, 31), Str) = 0 Then _ GoTo My_next A.Cells(m, 2).Resize(, 2).Value = _ K.Cells(i, 2).Resize(, 2).Value For col = 6 To 36 If K.Cells(i, col) = Str Then ALL = ALL & Day(K.Cells(4, col)) & "-" ALPHA = ALPHA & K.Cells(3, col) & "-" t = t + 1 End If Next col If t > 1 Then With A.Cells(m, 4) .Value = Mid(ALL, 1, Len(ALL) - 1) .Offset(, 1) = Mid(ALPHA, 1, Len(ALPHA) - 1) .Offset(, 2) = t - 1 .Offset(, 3) = K.Cells(2, "Q") .Offset(, 4) = Year(Date) End With m = m + 1 End If My_next: t = 1 ALL = " ": ALPHA = " " Next i Application.Calculation = xlCalculationAutomatic End Sub الملف مرفق Tarhil_3iyab.xlsm
    2 points
  7. 1 point
  8. وكيف يتم هذا , فطالما قمت بتقريب الأرقام الى ارقام صحيحة فلابد ان تتجاوز هذه الأعداد الإجمالى المطلوب والا فلا يتم المطلوب الا بهذه المعادلة ولكن سيكون هناك كسور كما اوضحت لك سابقا =CEILING($B$1*A2,0.5) تقريب.xlsx
    1 point
  9. السلام عليكم اخى واستاذى العزيز @أبو عبدالله الحلوانى ممكن تفتح موضوع وتشرح لنا كلنا حتى نستفيد كلنا ويكون مرجع للجميع لمن يهمهم الامر فى البرامج المحاسبيه تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق
    1 point
  10. جزاك الله خيرا استاذ العزيز وبارك الله فيك...الله يوفقك يارب .... نعم هذا كان المقصوذ
    1 point
  11. الله الله عليك / @أحمد الفلاحجى ربنا يفتح عليك تانى وتانى مجهودك وتفكيرك واضح جدا بارك الله فيك ورحم الله والديك
    1 point
  12. تم التعديل عند فتح الملف خاصية ( الأزار المتحركة تكون فعله وخاصية ( طباعه الخلايا المحددة بالماوس فقط ) تكون معطله عندما تريد استخدام خاصية ( طباعه الخلايا المحددة بالماوس فقط ) قم بتفعيل ( تشك بوكس ) بنفس الشت شاهد المرفقات Test_3.rar بإذن الله سأحاول عمل ذلك لكن ما هي الورقة المعنية بتلك المهمة ( الرورقة التي تعطينا منها الرقم )
    1 point
  13. بعد اذن اخى واستاذى @د.كاف يار اتفضل اخى وبالتوفيق ان شاء الله Pupil Names_UPDate.accdb
    1 point
  14. 1 point
  15. تحت امرك اخي ولكني بعد ان رفعت الملف لك وجدت ان كود ( الازرار المتحركة ) يوقف عمل كود ( طباعه الخلايا المحددة بالماوس فقط ) سوف اضببط الكوديين معا اولا ثم اجهز الشرح المطلوب لك
    1 point
  16. 1 point
  17. تفضل التعديل اخي الكريم Pupil Names.accdb
    1 point
  18. جزاك الله خير ... تم العثور على المطلوب في موقع أجنبي ولكي يستفيد الغير فكل ما عليك هو اضافة ورقة عمل جديدة داخل المصنف الذي ترغب بحمايته وكتابة رسالة تطلب من المستخدم تمكين وحدات الماكروا وبعد ذلك الذهاب الى محرر الاكواد بالضغط على ctrl + f11 والضغط مرتين على thisworkbook ثم لصق الكود التالي في المحرر Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim ws As Worksheet, wsSplash As Worksheet Application.ScreenUpdating = False Application.EnableEvents = False Set wsSplash = Worksheets("Splash screen") wsSplash.Visible = xlSheetVisible For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Splash screen" Then ws.Visible = xlSheetVeryHidden Next ws Cancel = True ThisWorkbook.Save For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Splash screen" Then ws.Visible = xlSheetVisible Next ws wsSplash.Visible = xlSheetVeryHidden Application.EnableEvents = True Application.ScreenUpdating = True End Sub Private Sub Workbook_Open() Dim ws As Worksheet, wsSplash As Worksheet Dim Pswd As String Pswd="myPassword" Application.ScreenUpdating = False Set wsSplash = Worksheets("Splash screen") wsSplash.Visible = xlSheetVisible For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Splash screen" Then If ws.Name="Sheet1" Then If InputBox("Please enter your password")=Pswd Then ws.Visible=xlSheetVisible Else ws.Visible = xlSheetVisible End If End If Next ws wsSplash.Visible = xlSheetVeryHidden Application.ScreenUpdating = True End Sub وكل ما عليك هو استبدال كلمة (splash screen) بأسم الصفحة التي أعددتها للتنبيه ومن ثم الحفظ بعد ذلك قم بإلغاء تفعيل وحدات الماكروا وافتح الملف ستظهر لك فقط الصفحة رقم 1 التي انشأتها وبها رسالة تطلب منك تمكين وحدات الماكروا وعند عمل ذلك وإعادة تشغيل الملف ستختفي الصفحة رقم 1 التي انشأتها وسيتم عرض بقية المصنف
    1 point
  19. السلام عليكم آسف إن كان كلامي بالمشاركة السابقة فهم علي أنه تعقيد - ماقصدت سوي توضيح بعض الأسس العلمية من الناحية المحاسبية لاستخلاص الربح أو الخسارة للنشاط بطريقة صحيحة تعبر فعلا عن نتيجة أعمال النشاط بما أن هذا مجال عملي كمحاسب أما عن كوني هاوي ومبتدأ بمجال البرمجة: فمن بداهيات ما تعلمنا من أساتذتا أننا نسخر البرمجة لتسهيل العمل بالقواعد الصحيحة وليس ابتكار قواعد جديدة تتوافق مع البرنامج -- وهذا يؤدي بدوره الي ما قال أخي حلبي وكذلك مما تعلمنا من اساتذتنا أننا نقدم النصح في حال وجد مايتطلب التعديل في طريقة العمل - فما أسهل أن أعالج لك مشكلة صغيرة ثم بعد حلها تجد لديك مشكلات أكبر منها تحتاج معها للعودة الي نقطة الصفر - أرجو ألا يحمل كلامي معنا آخر - فكل ما تقدم هو اعتذار عن الاطالة في المشاركة السابقة. أما عن استفسار أخي حلبي فهذا سيحتاج الي محاضرة أخري في الأسس المحاسبية 😁 وأعتقد ليس مكانها هنا حتي لا تطول الردود ويخرج الموضوع عن مساره وان سمح الوقت سأرسل لك ردا علي الخاص ان لم يكن لديك مانع. عودا الي سؤال أخي ibzmh2015 ان شاء الله سأطلع علي المرفق واوافيك بالنتائج .
    1 point
  20. تفضل -تصبح المعادلة هكذا =IFERROR(IF(ROWS(A$1:A1)>COUNTIF(E$4:E$100,"<>"""),"",INDEX($D$4:$D$100,SMALL(IF(E$4:E$100<>"",IF(E$4:E$100<>"",ROW(E$4:E$100)-ROW(E$4)+1)),ROWS(A$1:A1)))),"") Fathi2.xlsx
    1 point
  21. طلب الاخ ميلاد طارق في موضوع عمل زر متحرك طلب تطبيق الكود للتثبيت في حال وجود اكثر من شكل في نفس الصفحه كما في المرفق حتى اقوم بتثبيت الاشكال في باقي الشيتات وقد تم عمل اللازم المرفق Test_2.xls
    1 point
  22. والله يا جماعة الخير هذا الموضوع هام جدا جدا للجميع ، لانى ارى معظم الاسئلة والبرامج المعروضة فى منتدانا معظمها عن البيع والشراء والارباح وما ذكره خبيرنا / @أبو عبدالله الحلوانى اعتقد انه قريب من الصح من الناحية المحاسبية لانى قمت بسؤال خبراء المحاسبة في عملى قالو نفس الكلام مضاف اليه شوية حاجات تانية والذي اريده هنا (وانا غير متخصص فى المحاسبة) هو توضيح عملية حساب الارباخ ( سواء شهريا او سنويا او حتى ربع سنوية) مستخدما مثال الاخ السائل هناك خلل واختلاف كبير في طريقة حساب الارباح . فى كل برنامج عن الاخر . الكلام شفهيا جميل ولكن عند تظبيق الاكواد صعب جدا جدا اضم صوتى الى الاخ السائل فى توضيح ذلك ولماذا لا تحسب الارباح بان نظرح اجمالى مبلغ المبيعات من اجمالى مبلغ المشتريات ارجو ان لا يبخل علينا المتخصصين فى المحاسبة وان يتعب شوية معنا لوضع الحل الامثل جزاكم الله خيرا
    1 point
  23. السلام عليكم ورحمة الله وبركاته مبدأيا - من الناحية المحاسبية: مقابلة المشتريات بالمبيعات - كما هو بمثالكم - ينتج عنه اجمالي أرباح أو اجمالي خسائر, وهذا الرقم حقيقة لا يعبر عن صافي الربح أو الخسارة بشكل صحيح حيث هناك نوعان من المصروفات يجب تحميلها بشكل مناسب لهذا الرقم ليتم التعبير الصحيح من الناحية المحاسبية عن صافي الربح أو الخسارة. أ- مصروفات بيعية: والتي يتم تحميلها لـ حـ/ المتاجرة ويتم اضافتها الي تكلفة الانتاج أو الشراء, مثل: تكاليف نقل البضائع - تكاليف الدعاية والاعلان ... ب- مصروفات النشاط: وهي كل الأعباء والتكاليف التي يتحملها المتجر في مقابل استمرار النشاط - كفواتير الكهرباء والمياه والمصروفات النثرية ومرتبات الموظفين والضرائب والديون المعدومة والمخصصات السنوية و .... والتي يتم تحميلها لـ حـ/ الأرباح والخسائر -- والذي بدوره سينتج لنا الرقم المنشود وهو صافي الربح أو صافي الخسارة ( والذي سيتم ترحيله الي حـ/ صاحب المنشأة - بالنسبة للمنشآت الصغيرة - لمقابلته بالمسحوبات واعباء صاحب المشأة) والآن : انتهت تلك المحاضرة السريعة بالمحاسبة, لننتقل للأكسس 😁 كما سلف بالتوضيح السابق للأسس العلمية لمعالجة الأرباح والخسائر يجب أن يتم مراعات ذلك عند اعداد الاستعلامات المطلوبة فأنت بحاجة لاعداد استعلام يستدعي لك قيمة بضاعة أول المدة - واستعلام يستدعي لك قيمة بضاعة آخر المدة - استعلام يستدعي لك قيمة المشتريات والمبيعات والمصروفات البيعية ثم دمج تلك الاستعلامات داخل التقرير المناسب لاعداد حـ\ المتاجرة وهكذا بالنسبة لـ حـ\ الأرباح والخسائر أرجو أن أكون قد أفدتك ولو بمعلومة صغيرة.
    1 point
  24. السلام عليكم ورحمة الله وبركاته في المرفق التالي نموذج به قائمة منسدلة بها ارعة اعمدة الوظفه نص - الكادر رقم- حافز الاداء رقم -بدل المعلم رقم في جدول الوظائف jobs الجدول الاخر الرواتب كيف يتم عمل استعلام تحديث عند اختيار الوظيفة يتم تحديث الحقول لمبلغ كادر المعلم والاداء المميز و بدل المعلم في جدول الرواتب tb_rateb كود الاسم قائمة الوظائف كادر اداء مميز بدل معلم 1 محمود معلم 0.00 0.00 0.00 2 علي معلم اول ا 0.00 0.00 0.00 استعلام تحديث لاعمدة القائمة المنسدلة.rar
    1 point
  25. جرب هذا البرنامج ولكن عند تحويل سجلات كثيرة تأخذ منك وقت طويل ويمكن يهنق الجهاز فلذلك الافضل تجزيئ السجلات بمعنى كل مرحلة تجري لهم توليد الباركود على حدة يعني يكون عندك قائمة منسدلة تختار منها الصف تلو الإخر وبالتوفيق لك ...... مجلد جديد.rar
    1 point
  26. اهلا بك في منتداك نحن لا نعرف ماذا تريد بالاضبط لكن اتفضل اليك بعض روابط مختلفة سيكون فيها ما تريد ان شاء الله اليك هذا الموضوع تقدر تكبير وتصغير عناصر نموذج واليك هذا الرابط ايضا للاستاذ الشيخ صالح حمادي واليك هذا الرابط لاستاذ المصمم ابا جودي واليك هذا لتغير دقة الشاشة عندك حسب برامج تقبل تحياتنا
    1 point
  27. اخي الكريم حين تريد البحث عن كلمة معينة لا تكتفي بالبحث من بداية الجملة استخدم هذه الطريقة و ستجد انها تفي بالغرض Me.Form.Filter = "[Last_Name] LIKE '%" & [Text1] & "%' " Me.FilterOn = True
    1 point
  28. السلام عليكم اضع بين ايديكم هذه المعلومة حيث اخذت الفكرة من احد الاحبة في هذا المنتدى وطورتها بحيث لا تستطيع الحذف بعد ادخال البيانات والكبس على ايقونة حفظ ولكي تستطيع الحذف عملت نموذج اخر لا تستطيع الوصول اليه الا برقم سري الرقم السري 12345 جربوا الطريقة عساها تعجبكم العلم لا يحتكر delete_officna.accdb
    1 point
  29. وعليكم السلام ورحمة الله وبركاته لا يتم هذا الا عن طريق استعلام او Sql والاستعلام ابسط بالنشبة لك ملاحظة : جدول Data2 ضع حقل ID رقم وليس ترقيم تلقائي وذلك حتى يتم الحاق حقل ID من جدول Data به انظر المرفق Database1_3.rar تحياتي
    1 point
  30. انظر هنا وهنا هناك طريقة ثالثة افضل استخدامها ويمكن عملها بكتابة اكواد xml وهي اجمل وتجمع قوائم مخصصة واشرطة ادوات
    1 point
  31. السلام عليكم مرفق نموذج المطلوب : عند الضغط على علامة الاختيار وتصبح (صح) يكون رقم الايصال بالتنسيق التالى : 2019-1-R وهو عبارة عن R هو رمز الايصال 1 هو ترقيم متسلسل ـ يتغير عند الانتقال الى السجل التالى ويصبح رقم 2 -3-4 وهكذا ..... 2019 هو السنة الحالية ثابت لا يتغير الا اذا تغيرت السنة الحالية عند الضغط على علامة الاختيار مرة اخرى وتصبح (فارغة) يكون رقم الايصال فارغ بحثت وقرأت جميع الامثلة الموجودة وعند التطبيق لم اوفق جزاكم الله خيرا ترقيم متقدم.accdb
    1 point
  32. اخي العزيز انا فتحت ملف جديد بالاكسس ونسخت ملفاتك فيه من جديد واستبدلت كود الوحدة النمطية فقط واشتغل البرنامج بصورة صحيحة اخي العزيز / عندما تقوم باي عمل جديد بالاكسس / ضع عندك نسخة احتياطية للاحتياط لاي طاريء. تحياتي
    1 point
  33. وعليكم السلام ورجمة الله وبركاته يوجد مثال رائع لاستاذنا ابوخليل ترقيم متقدم.rar يمكنك التحكم بعدد الاصفار بجوار الرقم من خلال السطر التالي Me!Receiptno = "R-" & Format(xNext, "0000") & "-" & prtyr تحياتي
    1 point
  34. الصف الأول الاعدادى 11 / 11 / 2019 https://up.top4top.net/downloadf-1413oye831-rar.html الصف الثانى الاعدادى 11 / 11 / 2019 https://up.top4top.net/downloadf-1413shpw41-rar.html
    1 point
  35. الامر On Error Resume Next جدا خطير ، ويجب ان يُستعمل في حالات جدا خاصة 🙂 بينما كود اصطياد الخطأ الذي وضعته انا ، جدا مرن ، ويستوعب اي عدد من الاخطاء ، ويمكن معالجة كل نوع منها بطريقة خاصة 🙂 شوف مثلا اصطياد هذه الاخطاء ، وهذا كود من احد برنامجي : Exit Sub ProcError: Select Case Err Case 7874 'could not find QueryDef Resume Next Case 9 'Worksheet doesn't exist objXLWb.Worksheets.Add Set objXLSheet = objXLWb.ActiveSheet objXLSheet.Name = strWorkSheet Resume Next Case 1004 'Workbook doesn't exist, make it objXLApp.Workbooks.Add Set objXLWb = objXLApp.ActiveWorkbook objXLWb.SaveAs strWorkBook, FileFormat:=strSaveAs Resume Next Case 53 'file not found Resume Next Case 3270 'Field Caption not found, use field name objXLCell(, i + 1) = rs.Fields(i).Name Resume Next Case 3061 'too few parameters, expected 1 or more 'this error occurs when trying to run a query which needs its parameters from a Form, 'the Form should be open with the parameter, then this code take the values properly Dim qdf As QueryDef Dim prm As Parameter 'Set qdf = CurrentDb.QueryDefs("strSql") Set qdf = CurrentDb.CreateQueryDef("NewQueryDef", strSql) For Each prm In qdf.Parameters prm.Value = Eval(prm.Name) Next prm Set rs = qdf.OpenRecordset(dbOpenDynaset) DoCmd.DeleteObject acQuery, "NewQueryDef" Resume Next Case Else DoCmd.Hourglass False MsgBox Err.Number & " " & Err.Description 'Stop 'OkNotOk = "NotOk" Exit Sub Resume 0 End Select End Sub جعفر
    1 point
  36. السلام عليكم ورحمة الله مع دمج لعدة دوال تم عمل المطلوب في الملف المرفق بمعادلات صفيف.... أرجو أن تفي الغرض... بن علية حاجي تحصيل2.xlsx
    1 point
  37. هذا مثال بسيط عن استخدام الدالة dmax لعمل ترقيم مسلسل ، و نلجأ لهذه الطريقة عندما نريد السماح لنا بتعديل ترقيم المسلسل بسهولة و لأنه يمكن فى حالة تعدد المستخدمين أن يتم حجز رقم و اظهاره فى النموذج من قبل مستخدم بناء علي القيمة فى الجدول ، بينما يحجز مستخدم آخر نفس الرقم ، لذا يتم اعادة اختباره قبل التسجيل
    1 point
  38. الملف النهائي وبه كود للطباعه ============= لجان كنترول مدرسي1.rar ==========
    1 point
  39. كود رائع لازاله المسافات بين الكلمات يصلح مع كود الفرز Sub kh_TrimSelection() On Error Resume Next Dim cel As Range For Each cel In Selection.Cells If Not IsNumeric(cel) Then cel.Value = WorksheetFunction.Trim(cel) End If Next On Error GoTo 0 End Sub قف على اي خليه في عمود وسيتم بعد الضغط على الزر من ازاله المسافات بين الكلمات في العمود
    1 point
  40. كود يصلح للمدارس المصريه لاستخراج حاله الطالب '================================ 'هذا الكود للاستاذ المحترم ياسر العربي 'الهدف من الكود هو استخراج حاله الطالب سواء كان ناجحا او عنده دور تان او غايب ' Sub اظهار_حاله_الطالب() 'YASSER_ELARABY Dim ARR Dim ARRY Dim ARRYS '___________________________________________ Dim R As Long Dim X As Long Dim XX As Byte Dim ALL_LESS As String '___________________________________________ Const STATUS As Byte = 135 'عمود الحالة ناجح او دور ثان Const NOTES As Byte = 136 ' عمود الملاحظات عمود المواد او منقول للصف ا لاخر Const GENDER As Byte = 5 ' عمود الجنس ذكر او انثى '_____________________________________________________ Const LESS_ROW As Byte = 6 'صف الدرجة الصغرى Const NAM_ROW As Byte = 2 'صف اسماء المواد Const NAME_FIRST As Byte = 6 ' اول صف لاسماء الطلاب Dim NAME_LAST As Long: NAME_LAST = Sheets("بيانات المدرسة").Range("B10").Value + NAME_FIRST ' عدد الطلاب '_____________________________________________________ ARR = Array(20, 31, 42, 53, 68, 140) ' اعمدة اختبار الفصل الدارسي الثاني لجميع المواد ARRY = Array(24, 35, 46, 57, 72, 140) 'اعمدة الدرجة النهائية لجميع المواد ARRYS = Array(15, 26, 37, 48, 59, 140) 'اعمدة اسماء كل المواد '_____________________________________________________ With Sheet8 'اسم شيت البيانات Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual For R = NAME_FIRST To NAME_LAST ' حلقة تكرارية تبدأ بأول اسم طالب الى اخر اسم For X = 0 To UBound(ARR) ' حلقة تكرارية تبدأ من الصفر الى اقصى مصفوفة اعمدة اختبار الفصل الدارسي الثاني On Error Resume Next '____________________________________________________ 'يتم حساب عدد ا لمواد المتغيب بها الطالب او درجتها صفر ويتم وضع عدد المواد في المتغير اكس اكس 'اذا وصل عدد المواد الى 11 اصبح الطالب متغيب If .Cells(R, ARRY(X)) = 0 Or .Cells(R, ARRY(X)) = "غ" Then XX = XX + 1 End If '___________________________________________________ If ARR(X) = 140 Then 'مجموع 'لايوجد اختلاف بين هذا الكود وبين الكود الموجود بالاسفل If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لنصف الدرجة " & " - ": GoTo 86 GoTo 86 Else GoTo 86 End If End If '____________________________________________________ 'هذا الجزء خاص بمادة العلوم تحديدا الفصل الدراسي الثاني لانه مقسم على عمودين فتم اضافة هذا الجزء ليتم معالجة هذه المرحلة If .Cells(R, ARR(X)) < .Cells(LESS_ROW, ARR(X)) Or .Cells(R, ARR(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " لثلث الدرجة " & " - ": GoTo 86 End If If .Cells(R, ARRY(X)) < .Cells(LESS_ROW, ARRY(X)) Or .Cells(R, ARRY(X)) = "غ" Then ALL_LESS = ALL_LESS & .Cells(NAM_ROW, ARRYS(X)) & " - " End If '______________________________________________________ 86 Next X 'الذهاب الى المادة الاخرى لاعادة تطبيق الكود مرة اخرى حتى انتهاء جميع المواد 'اذا كان المتغير اكس اكس بيساوي عدد المواد اذن الطالب متغيب If XX = 6 Then ALL_LESS = "غياب ": XX = 0 '_____________________________________________________ 'هنا بعد اكتمال الكود يتم عمل شرط للمتغير 'ALL_LESS 'اذا كان المتغير فارغ اي لم يتم اضافة اي مواد به اذا الطالب ناجح If ALL_LESS = "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "ناجح" 'اذا كان نوع الطالب ذكر يتم وضع ناجح If .Cells(R, GENDER) = "أنثى" Then .Cells(R, STATUS) = "ناجحه" 'اذا كانت انثى يتم وضع ناجحه If .Cells(R, GENDER) = "ذكر" Then .Cells(R, NOTES) = "ومنقول " & Sheets("بيانات المدرسة").Range("B11") 'ويتم وضع في الملاحظات منقول الى ويتم جلب الصف من صفحة الانفو If .Cells(R, GENDER) = "أنثى" Then .Cells(R, NOTES) = "ومنقولة " & Sheets("بيانات المدرسة").Range("B11") 'مثل ماسبق 'اما اذا كان المتغير يحمل اي بيانات لمواد يصبح الطالب له دور ثان ElseIf ALL_LESS <> "" Then If .Cells(R, GENDER) = "ذكر" Then .Cells(R, STATUS) = "له دور ثان في" 'مثل ما سبق بخصوص النوع If .Cells(R, GENDER) = "أنثى" Then .Cells(R, STATUS) = "لها دور ثان في" ' .Cells(R, NOTES) = Left(ALL_LESS, Len(ALL_LESS) - 2) 'هنا يتم وضع قيمة المتغير اي المواد في خلية الملاحظات ALL_LESS = Empty 'تفريغ المتغير لاعادة تعبئة اسم طالب اخر End If '_____________________________________________________ Next R 'الذهاب الى الصف التالي حتى انتهاء عدد الطلاب End With Application.ScreenUpdating = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic MsgBox "بتوفيق الله .. تم اظهار النتيجة بنجاح" End Sub
    1 point
  41. كشوف لجان متميزه Sub PrintFrom8_To_() MsgBox "للحصول على طباعة كاملة يجب عدم ملامسة الماوس أو لوحة المفاتيح أثناء الطباعة" Dim I As Integer For I = Range("t7") To Range("u7") Step 2 If I <= Range("u7") Then Range("e5") = I ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True End If Next I Range("e5").Select End Sub كشوف لجان متميزه.rar
    1 point
  42. ملف رائع للعلامه عبد الله باقشير لاستخراج طلاب الدور التاني في كشف مناداه الدور التاني جزاه الله عنا كل خير على المنتدى استدعاء دون المستوى2.rar
    1 point
  43. استدعاء بيانات بطريقه سريعه جدا للحبيب ياسر العربي خليفه العلامه عبد الله باقشير استدعاء بيانات بطريقه سريعه.rar
    1 point
  44. لا داعى للسطر الثانى يكفى faray3.SetFocus وبما أن رقم علامة الجدولة فى النموذج الفرعى = 0 فإن التركيز ينتقل تلقائيا إلى حقل رقم صنف جرب أن تغير رقم مفتاح الجدولة لحقل رقم صنف إلى 2 مثلا
    1 point
  45. تم االتوصل الي حل اليكم الحل ليستفيد الجميع السطر الاول لنقل التركيز الي النموذج الفرعي (faray3) السطر الثاني لنقل التركير الي مربع النص (رقم الصنف) Me.faray3.SetFocus Form!faray3![رقم صنف].SetFocus
    1 point
  46. أولا :لماذا لا تجمع الحقول الأربعه الخاصه باليوم و التاريخ و السنه و الشهر في حقل واحد و تسميه تاريخ الزياره , و يتم تنسقه تنسيق طويل : اسم اليوم - اليوم - شهر - سنه ثانيا : لم توضح ماهي الطريقه التي تريد أن لا يتكرر بها تاريخ الزياره هل تريد عدم تكرار الزياره مره ف ياليوم أو الاسبوع أو الشهر أو السنه كيف تريد أن تبني الشرط الخاص بالتاريخ بالنسبه للمدرسه لوحدها كما قلت لك يمكن أن تجعل رقم المشرف و رقم المدرسه مفتاح أساسي , لكن لا بد أن تعرف الشرط الخاص بالتاريخ أولا
    1 point
  47. بالفعل أخي hghg كلامك صحيح ولكن هذا لا يعني أنني لم أجرب ذلك .. والفكرة واحدة .. على أي حال مرفق مثال لتجربته قم بعمل سي دي عليه برنامج الآلة الحاسبة ال calc.exe على ال root للسي دي .. وسيقوم البرنامج بتشغيله .. كما أنه يتفادى مشكلة وجود أكثر من رمز لمحرك الأقراص .. ويوجد أكثر من طريقة أخرى لتفادي هذه المشكلة .. مرفق أيضاً مثال لملف autorun.inf قم بوضعه على ال root للسي دي مع ملف ال calc.exe وستجد أنه يقوم بتشغيل الآلة الحاسبة تلقائياً .. CD.zip
    1 point
  48. المثال : و أعتقد أن النموذج الافضل فيه هو المنقول من الموضوع السابق للأخ أبو هادي ( رقم 2 ) و مرفق ال 4 نماذج 2 منضم + 2 غير منضم و قد تم تعديل موضوع حجز الرقم فى النماذج المنضمة بستخدام sendkeys قبل الخروج الأخ أبو يعلي : فى انتظار تجربتك و اختبارك للنماذج مع تحياتي Dmax.rar
    1 point
×
×
  • اضف...

Important Information