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

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

  1. صالح حمادي

    صالح حمادي

    أوفيسنا


    • نقاط

      8

    • Posts

      1,745


  2. مجدى يونس

    مجدى يونس

    أوفيسنا


    • نقاط

      7

    • Posts

      3,322


  3. رمهان

    رمهان

    الخبراء


    • نقاط

      5

    • Posts

      2,390


  4. jjafferr

    jjafferr

    أوفيسنا


    • نقاط

      5

    • Posts

      9,724


Popular Content

Showing content with the highest reputation on 24 فبر, 2019 in all areas

  1. فورم حضور وانصراف عاملين واذن خروج ودخول الفيديو الصور الملفات عدد 2 فى صفحة واحدة وفى 4 صفحات حضور وانصراف عاملين واذن خروج ودخول.rar حضور وانصراف العاملين.rar
    4 points
  2. بعضنا يضطر احيانا لأخذ قرض من البنك او شراء اثاث او اجهزة كهربائية بنظام الاقساط الشهرية من هنا جاءت فكرة هذا البرنامج الصغير لترتيب هذه الديون انا قم تبتصميمه واعمل عليه وهو مفتوح المصدر اتمنى لكم الفائدة الديون .accdb
    4 points
  3. تفضل التموذجين ثابتين في مكانهما و عند إغلاق نموذج يغلق معه النموذج الآخر شاشة نموذجي القراءة والاقتباس من الكتب2.rar
    3 points
  4. السلام عليكم أو هذه المعادلة: =TRIM(MID(A1;IFERROR(FIND("-";A1;1)+1;1);9^9)) بن علية حاجي فصل.xlsx
    2 points
  5. وعليكم السلام 🙂 رجاء مراجعة هذا الرابط جعفر
    2 points
  6. سامحونا لقد أثقلت عليكم الآن كيف يمكن أن نقوم بتسجيل الأداة دون عملية نقل الملف إلى مجلد system32 إذا كان الملف المراد تسجيله موجود بنفس مسار قاعدة البيانات وهذا هو الحل Private Sub أمر6_Click() sFileName = CurrentProject.Path & "\YsVedPic.OCX" RegisterFile (sFileName) End Sub تسجيل أداة أكيف أكس.rar
    2 points
  7. السلام عليكم تفضل هذا المرفق وضعت به زرين أحدهما لتسجيل الأداة و الآخر لحذف التسجيل كل ما عليك فعله هو وضع الأداة في مجلد system32 ثم افتح البرنامج و اضغط على زر تسجيل الأداة تسجيل أداة أكيف أكس.rar
    2 points
  8. مرحبا اخ @حلبي تم عمل الكود خلف زر حفظ وفقط يعدل السجلات التي لم تاخذ رقم لانه ممكن تدخل 10 سجلات بعد تضغط حفظ او حفظ بعد كل سجل تم عمل الترقيم عن طريق الاستعلام وبالاستعلام query1 بالتوفيق الاسبقية لرقم المقابلة.accdb
    2 points
  9. عزيزي حلبي جرب المرفق وبالكود وعند تاكيد هذا المطلوب نقوم بعمله بالاستعلام وبدون كود وطبعا ان حبيت ولم تكتفي بالكود تحياتي الاسبقية لرقم المقابلة.accdb
    2 points
  10. من المعروف ان الدالة Match تعطينا أول صف تراه في الجدول لكن بحيلة بسيطة يمكننا التغلب على هذه الدالة لتعطينا كل الصفوف (كل ذلك دون أخطاء N/A#) شاهد هذا الملف Multi_Match.xlsx
    1 point
  11. السلام عليكم أهلا ومرحبا أخي الكريم إستعنت بكود تفقيط عربي لأستاذنا الجليل عبد الله باقشير ستتعرف علي الكود وعلي المعادلات الجديدة المضافة للملف وكل ماهو بالفونط الأزرق حتي أنه كان عندك خطأ في العام (كتبت 2018 بدلا من 2019) في الخلية C16 بالورقة2 وكذلك أي خلايا بها عوامل مساعدة ستجدها بالأزرق أيضا بالجزء الرمادي بالورقة أرجو أن يكون المرفق هو ماتريد تفضل تصفيه_مستحقات.xlsm
    1 point
  12. 1 point
  13. احسنت استاذ وبارك الله بيك
    1 point
  14. احسنت ومجهود رائع بس عندي ملاحظة بسيطة على كشف الحساب اتمنى عند تسديد اي مبلغ ان ينزل من المبلغ الرئيسي يعني 5 مليون تصبح 4900 الف ثم 4800 الف وهكذا تحياتي وتقديري
    1 point
  15. بارك الله فيك استاذى الكريم عمل ممتاز جعله الله فى ميزان حسناتك
    1 point
  16. بارك الله فيكم جميعا واحسن الله اليكم كلها حلول ممتازة جعله الله فى ميزان حسناتكما وزادكما الله من فضله وسسع الله فى ارزاقكما جزاكم الله كل خير
    1 point
  17. هذه المعادلة =IF(ISNUMBER(FIND("-",A2)),REPLACE(A2,1,FIND("-",A2),""),A2)
    1 point
  18. بارك الله فيكم جميعا كلها حلول ممتازة احسنتما اساتذتى الكرام
    1 point
  19. مجهود رائع استاذ عبد اللطيف جزاك الله خيرا
    1 point
  20. السلام عليكم وحل آخر بالمعادلات... بن علية حاجي الملف.xlsx
    1 point
  21. ربما كان المطلوب الكود Option Explicit Sub fil_data() Dim S_rg As Range Dim I%, m% Dim st1$, st2$ Range("g3", Range("g4").End(4)).Resize(, 4).ClearContents Set S_rg = Range("b3", Range("b4").End(4)).Resize(, 4) For I = 1 To S_rg.Rows.Count If S_rg.Cells(I, 4) <> "مشطب" Then If S_rg.Cells(I, 3) & S_rg.Cells(I, 4) <> "3 جامعي" & "ناجح" Then Cells(m + 3, "G") = S_rg.Cells(I, 1) Cells(m + 3, "H") = S_rg.Cells(I, 2) Select Case S_rg.Cells(I, 3) & S_rg.Cells(I, 4) Case "1 جامعي" & "معيد": st1 = "1 جامعي": st2 = "نعم" Case "1 جامعي" & "ناجح": st1 = "2 جامعي": st2 = "لا" Case "2 جامعي" & "معيد": st1 = "2 جامعي": st2 = "نعم" Case "2 جامعي" & "ناجح": st1 = "3 جامعي": st2 = "لا" End Select Cells(m + 3, "I") = st1: Cells(m + 3, "j") = st2 m = m + 1 End If End If Next End Sub الملف مرفق jama3i.xlsm
    1 point
  22. وعليكم السلام 🙂 ماشاء الله ، مادام كل الشباب مشاركين ، فانا ادلو بدلوي كذلك 🙂 و جعفر
    1 point
  23. السلام عليكم إليك طريقة لتشغيل ملف صوتي مع الأكسس ضع هذا الكود في وحدة نمطية جديدة Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long اجعل اسم الملف الصوتي ringin و صيغته Wav و ضعه في في مجلد البرنامج و ضع هذا الكود خلف زر أمر Dim x2 As String x2 = (Application.CurrentProject.Path & "\ringin.wav") If apisndPlaySound(x2, 1) = 1 Then End If و هذا مثال لا أعرف مصدره تشغيل ملف صوتي بالأكسس.rar
    1 point
  24. الاخ هانى اى خدمة انا بعت الملفين والفيديو فى التحميل الاخ على شكرا لك سباق دائما فى الرد الفيديو فى التحميل
    1 point
  25. الاستاذ الكريم عبداللطيف عاشت ايدك وبارك الله فيك
    1 point
  26. السلام عليكم تفضل أنزع الضغط على المجلد و ضعه في أي مكان عند فتحه سوف تجد صورة متحركة بالنموذج صور متحركة.rar
    1 point
  27. ضع الاستعلام مصدر للنموذج مصدر رقم المقايلة هو expr1 وبالنسبة للكود تقدر تضغط زر الحفظ بعد كل ادخال سجل جديد او تعديل بالتوفيق
    1 point
  28. الاخ هانى نزلت لك الملفين على الرابط التالى
    1 point
  29. احسنت يا استاذ عبد اللطيف روعة من روائعك
    1 point
  30. حل فى منتهى الروعة جزاكم الله خير
    1 point
  31. بارك الله فيك أستاذ علي ولإثراء الموضوع يمكن باستخدام دالة if نتيجة الرابع والخامس والسادس.xlsm
    1 point
  32. اية الجمال والعظمة والمرونة ده ربنا يكرمك والف شكر على تعبك وسرعه ردك
    1 point
  33. الشكر موصول لك اخي عمر اتشرف باشتراكي في هذا المنتدي الرائع الذي منحني الفرصة للتعرف علي اخوة واصدقاء فضلاء لا يبخلون بما منحهم الله من علم وانت واحد من هؤلاء الفضلاء فتقبل تحياتي
    1 point
  34. @عبد اللطيف سلوم سأقوم بتحميل الملف والرد عليه ان شاءالله بعد تجربته
    1 point
  35. @ابو اشرف سلوم بعد التطبيق الملف رائع جدا بارك الله فيك بانتظار جديدك
    1 point
  36. وعليكم السلام اخى الكريم -نورت المنتدى تفضل سحب الدالة.xlsx
    1 point
  37. السلام عليكم جرب هذا المرفق OpenExelFile.rar
    1 point
  38. هناك موضوع أكثر أهمية في هذا الملف حيث تستطيع اختيار المرتبة التي تشاء (ليس الخامسة فقط بل الرابعة مثلا أو السابعة) تضع المرتبة التي تريد في الخلية E2 المعادلات في الملف محمية لعدم العبث بها عن طريق الخطأ Choose_grade.xlsm
    1 point
  39. وعليكم السلام-تفضل نتيجة الرابع والخامس والسادس.xlsm
    1 point
  40. السلام عليكم أولا : المعادلة في الخلية E5 هي: =DATE(année;INDEX(COLONNE(A:L);EQUIV(mois;MonthsNames;0));1) وبالإنجليزية: =DATE(année;INDEX(COLUMN(A:L);MATCH(mois;MonthsNames;0));1) والتي يمكن اختصارها على الشكل التالي: =DATE(année;EQUIV(mois;MonthsNames;0);1) وبالإنجليزية: =DATE(année;MATCH(mois;MonthsNames;0);1) مما يعني أن الجزئية (INDEX(COLONNE(A:L غير ضرورية في المعادلة... والمعادلة استعملت فيه الدالة DATE والتي تحتاج إلى ثلاثة وسائط بالترتيب التالي : 1- رقم السنة (وفي المعادلة تعطيه التسمية année، ثم 2- رقم الشهر الذي تعطيه الجزئية (EQUIV(mois;MonthsNames;0 أي رقم ترتيب اسم الشهر بالتسمية mois في قائمة الشهور بالتسمية MonthsNames، ثم 3- رقم اليوم وفي المعادلة هو رقم 1 أي في الأخير المعادلة ككل تعطي تاريخ أول يوم من الشهر في الخلية B7 والعام في الخلية B10... ثانيا : المعادلة في F5 : =SI(E5="";"";SI(MOIS(E5+1)>MOIS($E$5);"";E5+1)) وبالإنجليزية: =IF(E5="";"";IF(MONTH(E5+1)>MONTH($E$5);"";E5+1)) المتعلقة بالخلية E5 هي عبارة عن IF الدالة الشرطية (بشرطين) : الشرط الأول إذا كانت الخلية E5 فارغة تكون الخلية F5 فارغة أما إذا كانت الخلية E5 غير فارغة فإن الدالة تتحقق من الشرط الثاني الذي هو : (mois(E5+1)>mois(E5 أي إذا كان شهر (التاريخ في E5 بإضافة 1 يوم له) أكبر من (شهر تاريخ الخلية E5) فإن الخلية F5 تبقى فارغة، وإذا لم يكن كذلك فإن الخلية F5 يكون فيها تاريخ اليوم الذي يلي تاريخ الخلية E5 من الشهر نفسه... والله أعلم في الملف المرفق تم تعديل آخر بحيث أدرجت أعمدة لكل الشهور مع إضافة بعض النطاقات بالتسمية (للضرورة) مع كود بسيط وُضع في حدث الورقة (الشيت) يقوم بإظهار جدول الشهر المختار في الخلية B7 وإخفاء جداول كل الشهور الأخرى... وهذا تسهيلا لأرشيف الشهور مما يفيد في العمليات الإحصائية الشهرية أو السنوية... بن علية حاجي absenses.xlsm
    1 point
  41. اليك هذا لا اعرف من هو صاحبه لذلك ادعوا له اخفاء رسالة بعد عدد ثواني.mdb
    1 point
  42. اخي الفضل هذا الموقع فيه كل ما تريد https://www.mutaz.net/free-programs/
    1 point
  43. وعليكم السلام هذه 6 طرق ، برسائل وبدون ، وانا اخترت لك آخر واحدة منها ، وهي تعطيك شريط في اسفل شاشة الاكسس: . Option Compare Database Private Sub أمر10_Click() On Error GoTo Err_أمر10_Click 'Dim stDocName As String 'stDocName = "q1" 'DoCmd.OpenQuery stDocName, acNormal, acEdit '1 العمل بصمت وبدون اشعارات ' CurrentDb.Execute ("q1") '2 العمل بصمت وبدون اشعارات ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True '3 العمل بصمت وبدون اشعارات ، ولكن بوجود ساعة ترابية تشير الى وجود عمل ' DoCmd.Hourglass True ' DoCmd.OpenQuery "q1" ' DoCmd.Hourglass False '4 عمل اشعار ثابت لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' Application.Echo True ' Application.Echo False, "الاستعلام يقوم بالتحديث" ' ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' Loop ' ' Application.SetOption "Show Status Bar", False ' Application.Echo True '5 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' SysCmd acSysCmdSetStatus, "الاستعلام يقوم بالتحديث" ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' A = A + 1 ' If A / 50 = Int(A / 50) Then B = B & " . " ' SysCmd acSysCmdSetStatus, B & "الاستعلام يقوم بالتحديث" ' Loop ' Application.SetOption "Show Status Bar", False ' SysCmd acSysCmdClearStatus '6 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة Application.SetOption "Show Status Bar", True SysCmd acSysCmdInitMeter, "الاستعلام يقوم بالتحديث", 5000 DoCmd.SetWarnings False DoCmd.OpenQuery "q1" DoCmd.SetWarnings True PauseTime = 3: Start = Timer Do While Timer < Start + PauseTime DoEvents A = A + 1 SysCmd acSysCmdUpdateMeter, A Loop Application.SetOption "Show Status Bar", False SysCmd acSysCmdClearStatus Exit_أمر10_Click: Exit Sub Err_أمر10_Click: MsgBox Err.Description Resume Exit_أمر10_Click End Sub . وهذا الرابط فيه البرنامج المرفق ، يعني خذ منه الكود وخليه في برنامجك : http://www.access-programmers.co.uk/forums/attachment.php?attachmentid=32438&stc=1&d=1275923825 . . والنتيجة Notification بطريقة البرامج المحترفة ، فوق ساعة الكمبيوتر . جعفر 876.msg styles.mdb.zip BalloonToolTipSample.mdb.zip
    1 point
  44. اخي الفاضل ليس معطوب نزل اخر اصدار winrar هذة الرساله DoCmd.Beep If MsgBox(" هــل تـريـد نــســخ الاسـمـاء إلـى قـاعـدة الـعـمـلاء " & vbCrLf & "", vbYesNo, " بـرنـامـج الـخـيـاط ") = vbYes Then Dim strSQL As String DoCmd.SetWarnings False DoCmd.OpenQuery "q1" DoCmd.SetWarnings True Beep MsgBox " تـم نــســخ الاسـمـاء إلـى قـاعـدة الـعـمـلاء بـنـجـاح", vbInformation, " بـرنـامـج الـخـيـاط "
    1 point
  45. السلام عليكم قد نريد ان نجعل الرسالة تبقى لمدة معينة ، واذا لم يقوم المستخدم بعمل شيء ، تقوم الرسالة بإختيار "لا" وتغلق نفسها ، Private Sub cmd_Timer_msgbox_Click() Dim Msg, Style, Title, Response, PauseTime Dim Sh_Msgbox As Object PauseTime = 5 'Seconds Msg = "هل تريد الاستمرار" Style = vbYesNo + vbCritical + vbDefaultButton2 Title = "الشاشة ستغلق تلقائيا بعد 5 ثوان" Set Sh_Msgbox = CreateObject("WScript.Shell") Response = Sh_Msgbox.PopUp(Msg, PauseTime, Title, Style) If Response = vbYes Then MsgBox "تم اختيار نعم" Else MsgBox "تم اختيار لا ، او انتهى الوقت" End If End Sub جعفر Msgbox Timer.MDB.zip
    1 point
  46. السلام عليكم الاخ الكريم / على حسن بارك الله فيك وبعد رد اخي الحبيب جدا / سليم حاصبيا ... جزاه الله خيراً ارجو اضافة ولو معلومة علها تفيدك عن انواع امتدادات الاكسيل اليك اخي الكريم ... كل امتدادت الاكسيل والفرق بينهم ( راجعهم واختار ما يناسبك منهم ) XLS تستطيع قرائتها بالإكسل 2003 XLS تستطيع الإحتفاظ بالكود فيها بداية من أوفيس 2007 ، تم استبدال XLS بثلاث إمتدادات xlsb ، xlsx ، xlsm وثلاثتهم لايستطيع الأوفيس 2003 قرائتهم إلا بإضافة أداة جديدة إضافية 1- الإمتداد xlsx لحفظ ملفات الإكسل العادية التي لاتحتوي علي أكواد ، فإن كتبت كود وحفظت الملف بهذا الإمتداد ولم تنتبه لرسالة التنبيه وأغلقت الملف ، فلن تجد الكود مرة أخري عند الفتح 2- الإمتداد xlsm لحفظ ملفات الإكسل التي تحتوي علي أكواد 3- الإمتداد xlsb لحفظ ملفات الإكسل (مع أكوادها) ، ولكن لاتستطيع عمل مشاركة لهذا النوع من الملفات للعمل بأكثر من مستخدم علي الملف في الشبكة ، أي Share ودائما ننصح باستخدام xlsb بدلا من xlsm لقلة حجم هذا النوع الملحوظة بالنسبة للآخرين (( إلا في حالة مشاركة الملف علي الشبكة )) ارجو ان اكون قد افدتك ولو قليلا تقبل خالص تحياتي
    1 point
  47. تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة تذكير بتاريخ الإنتهاء من خلال الفورم تم ارفاق الكود من الاستاذ / ابو القبطان و تعديل المبدع / ياسر خليل أبو البراء و لا تنسونا من صالح الدعاء تحياتى تذكير بموعد التحصيل.rar
    1 point
  48. اخى الحبيب نزل الملف التالى عله يفيدك http://www.mediafire.com/download/1tkrlz371wmuhse/%D8%AA%D8%AD%D9%84%D9%8A%D9%84+%D8%A7%D9%84%D8%A8%D9%8A%D8%A7%D9%86%D8%A7%D8%AA+%D9%88%D8%A7%D8%B9%D8%AF%D8%A7%D8%AF+%D8%A7%D9%84%D8%AA%D9%82%D8%A7%D8%B1%D9%8A%D8%B1+%D8%A8%D8%A7%D8%B3%D8%AA%D8%AE%D8%AF%D8%A7%D9%85+%D8%A7%D9%84%D8%A7%D8%AF%D8%A7%D8%A9+Power+Pivot+for+Excel+2010.rar
    1 point
  49. السلام عليكم يتم استخراج البيانات لكل القيم الفريدة في العمود بي للورقة Data1 Option Explicit Private Const ContColmn As Integer = 5 '====================================================== '====================================================== Sub kh_Report() Dim obj As Object Dim Ar() As Double, XX() As Double, X() As Double Dim v As Double, vv As Double Dim Rng As Range Dim LastRow As Long, iCont As Long Dim i As Long, ii As Long, iii As Long, R As Long Dim C As Integer Dim tx '''''''''''''''''''''' On Error GoTo kh_ex Set obj = CreateObject("Scripting.Dictionary") ''''''''''''''''''''' '============================================ kh_Clear '============================================ With æÑÞÉ2 LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Rng = .Range("A1:D" & LastRow) End With '============================================ ReDim Ar(1 To ContColmn - 1) For C = 1 To ContColmn - 1 Ar(C) = Range("B1").Cells(1, C).Value Next tx = Range("F1").Value '============================================ kh_Application False With Rng .Sort .Columns(2), xlAscending For i = 1 To .Rows.Count v = .Cells(i, "B").Value vv = Val(.Cells(i, "D")) If obj.Exists(v) Then iii = obj(v) '''''''''''''''''' If .Cells(i, "C").Value = tx Then For C = 1 To ContColmn - 1 If .Cells(i, "A").Value = Ar(C) Then XX(C + 1, iii) = XX(C + 1, iii) + vv Next End If Else ii = ii + 1 ReDim Preserve XX(1 To ContColmn, 1 To ii) obj.Add v, ii '''''''''''''''''' XX(1, ii) = v If .Cells(i, "C").Value = tx Then For C = 1 To ContColmn - 1 If .Cells(i, "A").Value = Ar(C) Then XX(C + 1, iii) = vv Next End If End If Next End With ''''''''''''''''''''''''''''''' iCont = obj.Count If iCont Then Erase Ar ReDim Ar(1 To ContColmn - 1) ReDim X(1 To iCont, 1 To ContColmn) For i = 1 To iCont X(i, 1) = XX(1, i) For C = 1 To ContColmn - 1 Ar(C) = Ar(C) + XX(C + 1, i) X(i, C + 1) = Ar(C) Next Next With Range("A2").Resize(iCont, ContColmn) If iCont > 1 Then .Rows(1).AutoFill .Cells, xlFillFormats .Value = X End With ''''''''''''''''''''''''' End If '============================================ kh_ex: kh_Application True '''''''''''''''''' '''''''''''''''''' '''''''''''''''''' Set obj = Nothing Set Rng = Nothing Erase XX, X, Ar '''''''''''''''''' If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear End If End Sub شاهد المرفق 2010 Ex1.rar
    1 point
×
×
  • اضف...

Important Information