اذهب الي المحتوي

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


Popular Content

Showing content with the highest reputation since 20 يول, 2019 in all areas

  1. 8 points
    كنوع من رد الجميل لهذا المنتدى الرائع والقائمين عليه اقدم هذا البرنامج هدية مجانية لعل وعسى يستفيد منه أحد الرقم السري لفك الضغط 12345 شرح سريع للبرنامج دعواتكم لوالدي بالرحمة والمغفرة برنامج تحصيل الايجارات من الشقق - الاصدار الاول.rar
  2. 7 points
    وعليكم السلام-تفضل يمكنك استخدام هذه المعادلة =IF(AND(C1="",D1=""),"",IF(C1=D1,"متزن","غير متزن")) دالة if بأربع شروط.xlsm
  3. 7 points
    السلام عليكم كما عودناكم عى كل جديد فقد قمت بتصميم برنامج خاص بمحلات الجوالات لصديق لي من المملكة العربية السعودية اضع البرنامج بين ايديكم وهو مفتوح المصدر لكي تستفيدو منه الرقم السري لاكواد فيجوال بيسك 1968 والشفت ممكن به لا تحرمونا من الدعاء mobilesv.3-KSA.rar
  4. 7 points
    السلام عليكم برنامج المطاعم قمت بتطويره اعتقد أنه أحد مشاركات الأستاذ القدير رمهان . وبالتوفيق مثال للاستفادة من الأفكار وسامحوني على تداخل الألوان كان على عجالة . أخوكم ومحبكم صالح البريكان أبوآمنة TestM.rar
  5. 7 points
    - موديول إخفاء إطار الأكسس - التوسيط - التصغير بجوار الساعة - تغيير الأيقونة - استدعاء بيانات ورسائل من جدول تم وضع التذكيـــر الاتى برأس الموديول لسهولة التعامل مع الأكودا واستدعائها 'icon path >>---> CurrentProject.Path &"\"&"\File Library\Fav Ico\Myicon.ico" 'Hide Access >>---> CallStartForm() 'CenterObjects >>---> Call CenterFrm(Me) 'Minimize To Systray >>---> Call AppMini() 'To Quit Application >>---> Call AppQuit() 'To Close Any Forms >>---> Call AppCloseFrm() 'Application Name >>---> Call AppName() 'Designer Name >>---> Call DesName() 'Designer Phone >>---> Call DesPhone() 'Designer Email >>---> Call DesEmail() 'call Any Message From Table '>>>>> StrMyCriteria = "MyCriteria ='xxxx'" '>>>>> MyMesg (txtOfMesg), vbOKOnly, strMsgTitle '>>>>> Change "xxx" By Criteria From Table >> UsystblUsefulData << By Criteria From Field [MyCriteria] '>>>>> Example MyCriteria >>---->> msgDesData '>>>>> StrMyCriteria = "MyCriteria ='msgDesData'" '>>>>> MyMesg (txtOfMesg), vbOKOnly, strMsgTitle هذا المرفق الاول بدون عمل اختصار للبرنامج Utilities Hide Ico Minimze To SysTray.zip --------------------------------------------------------------- هذا المرفق للإضافة إختصار أليا الى سطح المكتب وتحكم كامل فى كل ما يخص الاختصار من الجدول UsystblUsefulData اسم الاختصار الوصف مفتاح الاختصار من الكيبور لفتح التطبيق وفى حالة عدم وجود اى بيانات بالجدول تخص الاختصار او عدم وجود ايقونة فى المسار المخصص يتم استخدام البيانات الاساسية والايقونة الاساسية Utilities Hide Ico Minimze To SysTray V.02.zip
  6. 6 points
    السلام عليكم و رحمة الله تعالى وبركاته نعاني دائما من تصدير البيانات إلى الوورد للتعديل عليها أو لأي غرض آخر و خاصة الجداول أقدم لكم هذا المثال البسيط الذي يقوم بتصدير البيانات لملف وورد معد مسبقا و يقوم بملئها في أماكنها و كلما زاد سجل زاد له سطر في جدول الوورد و هذا هو المثال فيه نسختين 2003 و نسخة 2010 التصدير لملف وورد معد مسبقا.rar
  7. 5 points
    بيانات الموظف ومرفقات منوعة للموظف الفيديو الصور
  8. 5 points
    السلام عليكم ورحمة الله وبركاتة يكثر السؤال عن الغاء الحفظ التلقائي في الاكسس وهذه الخاصية بطبيعة الحال غير موجودة مع النماذج المنضمه ولتغلب على هذا الأمر نحتاج لعمل طريقة نتحايل بها على الاكسس لنعيد السجل بالنموذج الرئيسي وكل السجلات بالنموذج الفرعي إلى سابق عهدها قبل التعديل عند النقر على زر أمر تراجع عن التعديل أو التراجع عن إضافة سجل المثال المرفق فيه فكرة لذلك عن طريق عمل جداول مؤقته نأخذ منها قيم السجلات قبل التعديل وتحديث السجلات من خلالها في الجدول الاساسي هناك فكرة أخرى عن طريق عمل المصفوفات وهي للاستغناء عن الجداول المؤقت ولكنها صعبة نوعا ما ولا أجيد التعامل معها باحترافية لعل احد الاساتذه أو الاعضاء يطبق الفكرة من خلال المصفوفات وإليكم المثال قم بالتعديل او الحذف للحقول في النموذج الاساسي والنموذج الفرعي واحذف وأضف سجلات كاملة بالنموذج الفرعي ثم أنقر على زر تراجع وانظر النتيجة ::بالتوفيق للجميع :: disableSavKaser96.rar
  9. 5 points
    تفضل يمكنك استخدام هذا الكود Private Sub CommandButton2_Click() Dim str As String Dim i As Long For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then If str <> vbNullString Then str = str & ", " str = str & ListBox1.List(i) End If Next TextBox2.Text = TextBox2.Text & " " & str End Sub ليست بوكس.xlsm
  10. 5 points
    السلام عليكم ورحمة الله وبركاتة هذا مثال يتم من خلاله ربط الجداول برمجيا بدون تدخل من المستخدم عند فتح قاعدة الواجهات kaser906 يتم ربط الجداول بقاعدة جداول kaser906_be والقاعدة الثانية kasr9062 وكلتا القاعدتين مغفلتين برقم سري 1234 ضع المجلد في أي مكان او غير أسم المجلد وفتح قاعدة بيانات الواجهات kaser906 ستجد أن ربط الجداول تم بدون تدخل منك ::بالتوفيق للجميع :: TablLinkind.rar
  11. 5 points
    الأمر بسيط تم التعديل على الملف واستخدام هذه المعادلة =IF(F4="","",(TODAY()-F4)+1)
  12. 5 points
    تفضل لك ما طلبت-كما قلت لك سابقا لابد من ضبط تنسيق الرقم القومى مش عارف ليه الموضوع صعب كده معك يا استاذ على فقط كان عليك ضبط التنسيق مع تثبيت الجزء الموجود بالمعادلة الخاص بالصفحة الأخرى اى وضعه بين علامة الدولار كما تلاحظ المعادلة المفروض والصح تكون هكذا =IFERROR(VLOOKUP(A2,'رقم الموظف'!$A$1:$G$130,5,0),"") Pay-aht_moustafa-20190802-040908.xlsx Pay-mttks_magdi-20181011-082233-2019 - Copy.xls
  13. 5 points
  14. 5 points
    طريقة سهلة لضبط الحجم اثناء التكبير والتصغير للنموذج تحافظ الايقونات على الحجم حيث تكبر وتصغر مع النموذج الخطوات : 1- جعل الايقونات مكدس 2- تصغير الحجم الى نصف نقطة عرض والى 1 من عشرة ارتفاع 3- جعل الارتساء الافقي والعامودي كلاهما 4- جعل النموذج منبثق 5- اختار يمكن تغيير حجمه وليس مربع حوار خدعة الضبط للنماذج.accdb
  15. 5 points
    تفضل الكود داخل الملف #If Win64 Then Private Declare PtrSafe Function MsgBoxTimeout _ Lib "user32" _ Alias "MessageBoxTimeoutA" ( _ ByVal hwnd As LongPtr, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long) _ As Long #Else Private Declare Function MsgBoxTimeout _ Lib "user32" _ Alias "MessageBoxTimeoutA" ( _ ByVal hwnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal wType As VbMsgBoxStyle, _ ByVal wlange As Long, _ ByVal dwTimeout As Long) _ As Long #End If Sub btnMsgbox() Call MsgBoxTimeout(0, "اللهم صلى على سيدنا محمد", "منتدى أوفيسنا", vbInformation, 0, 4000) Call Test End Sub Sub Test() Application.OnTime Now + TimeValue("00:10:00"), "btnMsgbox" End Sub رسالة الصلاة على سيدنا محمد 2.xlsm
  16. 5 points
    بعد اذن الأستاذ سليم -تفضل كود واحد يرحل جميع البيانات الى جميع الادارات وفق اسم الادارة ونوع المدرسة2.xlsm
  17. 5 points
    اتفضل شرح بسرعة - جرب اضافة ملفاتك الصوتية قبل فتح البرنامج الى المجلد المرفق باسم sound files يا عينى ع الدلع APP_Player.zip
  18. 4 points
  19. 4 points
    السلام عليكم هدية متواضعه برنامج بسيط لتسجيل الديون المستحقة عليك ومتابعة تسجيل الدفعات الشهرية وكشف حساب اتمنى لكم الفائدة الديون .accdb
  20. 4 points
    وعليكم السلام تم زيادة الخلايا وبالفعل لدى القائمة المنسدلة الإستكمال التلقائى وهو بمجرد كتابة الحرف الأول وفتح سهم القائمة سترى الأسماء التى تبدأ بهذا الحرف ولا يمكن عمل أكثر من هذا فى موضوع القائمة المنسدلة بارك الله فيك تم التعديل هنا قائمه منسدله مطاطية تقبل البحث فيها بدون تكرار وبدون فراغات.xlsx
  21. 4 points
    طريقة جديدة للبحث عن الاسم اتمنى لكم الفائدة search.accdb
  22. 4 points
    بارك الله فيك ورحم الله والديك استاذنا الكريم
  23. 4 points
    كل عام وانتم بخير وعيد سعيد عليكم جميعا بارك الله فيك استاذنا الكريم وجزاك الله خير الثواب
  24. 4 points
    أحسنت أستاذ عبد اللطيف بارك الله فيك وزادك الله من فضله وكل عام وانتم بخير
  25. 4 points
    بعد اذن اساتذتى الكرام الاستاذ سليم والاستاذ احمد واثراء للموضوع جرب هذا الملف لعله يفى بالغرض نسخة من New Microsoft Excel Worksheet (2).xlsx
  26. 4 points
    بارك الله فيك أستاذ أحمد وكل عام والأمة الإسلامية بخير وعيد أضحى سعيد أعاده الله علينا جميعا بالخير واليمن والبركات
  27. 4 points
    بارك الله فيك استاذ خيرى وكل عام وانتم بخير وعيد أضحى سعيد ادام الله علينا جميعا هذه الأيام بالخير واليمن والبركات
  28. 4 points
    عليك برفع الملف حتى تستطيع الأساتذة معاينة المشكلة عن قرب بارك الله فيك وكل عام وانتم بخير
  29. 4 points
    بعد اذن اخي علي معادلة بشكل ثاني =CHOOSE(AND(C1=D1,C1<>"",D1<>"")+1,"غير متزن","متزن")
  30. 4 points
    الأمر في غاية البساطة عليك بعمل الخطوة التي تراها بالصورة
  31. 4 points
  32. 4 points
    بعد اذن اخي بن علية ثلاث حلول في 3 صفحات (تم تغيير الاسماء واختصار البيانات للتدقيق في صحة المعادلات) هناك حسب ما اعتقد حل رابع لم استطع معالجته لضيق الوقت اختر ما يناسبك Takrir.xlsx
  33. 4 points
    على الرغم انك لم تقم الا برفع ملف خالى من البيانات ولم تقوم بشرح المطلوب عليه, الا وقد تم عمل المطلوب كما تريد , تفضل project.xlsx
  34. 4 points
    هل يمكن لبرنامج اكسل ان يقوم بتقسيم الصورة علي مجموعة خلايا بنسبة مئوية معينة انظر لهذا الملف لتفهم ما أقصده Complete_picture.xlsx
  35. 4 points
    أحسنت استاذنا الكريم عمل رائع بارك الله فيك وزادك الله من فضله
  36. 4 points
    1- قم بتسمية الورقة الرئيسية بغير رقم مثلاً "main_sheet" او اي اسم تختاره 2-قم بتسمية الأوراق التي ترغب بمسح النطاق منها بالارقام مثلاً "1" "2" "15 " الخ.. نفذ هذا الماكرو (ستلاحظ الاوراق التي يحتوي اسمها على كلمات لا يتعاطى معها الماكرو) الماكرو Option Explicit Sub del_Ranges() Dim my_Srting$: my_Srting = "D5:F35" Dim sh As Worksheet For Each sh In Sheets If sh.Name Like "#*" Then sh.Range(my_Srting).ClearContents End If Next End Sub الملف مرفق كنموذج MOURATABAT.xlsm
  37. 4 points
    أحسنت أستاذ وجيه معادلة ممتازة-بارك الله فيك
  38. 4 points
    جرب الملف الأن تم التعديل ولا تظهر هذه الرسالة
  39. 4 points
    ليس هناك مشكلة في هذا -أهم حاجة ان الملف يعمل بكل كفاءة
  40. 4 points
    فقط عليك الضغط على Alt +F11 وفتح مديول جديد ووضع هذا الكود به مع تحديد الرينج المطلوب كما بالكود وربطه بالزر Sub Print1() Range("a2:b74").PrintOut End Sub
  41. 4 points
    فكرتها هي نفس فكرة نسخة في مجلد على الجهاز ..... لأن هذه المواقع لها برنامج يتم تنصيبة على الجهاز وتعمل لك مجلد متزامن مع الموقع فاي اضافة او حذف للملفات يقوم بالتزامن مع الموقع .... وبامكانك استيراد هذه الملفات من أي جهاز عن طريق النت ......
  42. 4 points
    خطرت لي فكرة الأن ولم اجربها وهي النسخ لـ Google Drive أو Dropbox مثلا ........
  43. 4 points
    وعليكم السلام-تفضل الأثاث.xlsm
  44. 4 points
  45. 4 points
    يارك الله فيك اخي علي وهذا كود اخر يعتمد على Dictionary لتحديد المدارس المطلوبة و على Auto Filter لكل مدرسة اظن انه أسرع لنقل ال Data الى الصفحة المطلوبة Option Explicit Sub test() '====>>> CREATED BY SALIM ON 28/7/2019 Application.ScreenUpdating = False '+++++++++++++++++++++++++++++++++++++++ Start Of DIM Dim Fst As Worksheet: Set Fst = Sheets("Data") 'First Sheet Dim Sec As Worksheet ' Seconde sheet Dim LRU% ' LRU Num of Rows in First sheet column U Dim i%, ky, m%: m = 6 'm row's number when the data will start Dim D As Object ' D Dictionary Dim Fst_Rg As Range 'My range On first sheet '+++++++++++++++++++++++++++++++++++++++ End Of DIM Set D = CreateObject("Scripting.Dictionary") LRU = Fst.Cells(Rows.Count, "U").End(3).Row Set Fst_Rg = Fst.Range("a2").Resize(LRU, 30) '''''''''''''''''''''''''''Start Of For_next Loop to fill the Dictionary For i = 3 To Fst_Rg.Rows.Count If Not D.exists(Fst.Cells(i, "U").Value) And _ Len(Fst.Cells(i, "U")) > 3 Then D.Add Fst.Cells(i, "U").Value, "" End If Next i '''''''''''''''''''''''''''End Of For_next Loop to fill the Dictionary '+++++++++++++++++++++++++++++++++ fil All sheets with auto filter For Each ky In D.keys Set Sec = Sheets(ky) Sec.Range("c6").CurrentRegion.ClearContents ' Clean Up the Data in Seconde sheet Fst_Rg.AutoFilter 21, CStr(ky) 'filter by column(21)==>> N Fst_Rg.Cells(1, 1).Resize(LRU - 1, 20).SpecialCells(12).Copy _ Sec.Range("C" & m) Next ky '++++++++++++++++++++++++++++++++++++ If Fst.FilterMode Then _ Fst.ShowAllData: Fst_Rg.AutoFilter '====== Clear Autofilter from sheet Data '++++++++++++++++++++++++++++++++++++++ Clean Up the Memory D.RemoveAll: Set D = Nothing: Set Fst_Rg = Nothing Set Fst = Nothing: Set Sec = Nothing '++++++++++++++++++++++++++++++++++++++ Application.ScreenUpdating = True End Sub
  46. 4 points
    مشغل صوتيات أرجو أن ينال استحسانكم متروك للتطوير وابدا الرأي اللون الأسود لمناسبة لون الشاشة فقط لا اكثر ولا أقل طريقة عمل البرنامج أولا اضافة سجل ثم كتابة اسم الملف الصوتي والضغط على حفظ حتى يحفظ المسار بالقاعدة للرجوع إليه فيما بعد إذا اردت تشغيله مرة أخرى فقط تختارة من القائمة اتركم مع البرنامج والله ولي التوفيق MediaOfficena.accdb
  47. 4 points
    تفضل بعد اذن الأستاذ رجب إخفاء الصفحات.xlsm
  48. 4 points
    اذا اردتها عاموديا اكتب هذا المعادلة(اينما تريد) واسحبها نزولاً =ROWS($A$1:A1)*50 اذا اردتها افقياً اكتب هذا المعادلة(اينما تريد) واسحبها بالعرض =COLUMNS($A$1:A1)*50
  49. 4 points
  50. 4 points
    =COUNTIF($C$5:C5,C5)+VLOOKUP(C5,{"اعدادي",19100;"ثانوي",19200},2,0)-1 السلام عليكم ورحمة الله استخدم المعادلة التالية فى العمود "D" =IF(C5="اعدادي";COUNTIF(C5:$C$5;C5)+19100;IF(C5="ثانوي";COUNTIF(C5:$C$5;C5)+19200;"")) استاذ ابراهيم تكفي هذا المعادلة =COUNTIF($C$5:C5,C5)+VLOOKUP(C5,{"اعدادي",19100;"ثانوي",19200},2,0)-1 مع مراعاة ( الفاصلة والفاصلة المنقوطة _حسب اعادادات الجهاز عنكم)


×
×
  • اضف...