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

كنوع من رد الجميل لهذا المنتدى الرائع والقائمين عليه اقدم هذا البرنامج هدية مجانية لعل وعسى يستفيد منه أحد الرقم السري لفك الضغط 12345 شرح سريع للبرنامج دعواتكم لوالدي بالرحمة والمغفرة برنامج تحصيل الايجارات من الشقق - الاصدار الاول.rar

وعليكم السلام-تفضل يمكنك استخدام هذه المعادلة =IF(AND(C1="",D1=""),"",IF(C1=D1,"متزن","غير متزن")) دالة if بأربع شروط.xlsm

السلام عليكم كما عودناكم عى كل جديد فقد قمت بتصميم برنامج خاص بمحلات الجوالات لصديق لي من المملكة العربية السعودية اضع البرنامج بين ايديكم وهو مفتوح المصدر لكي تستفيدو منه الرقم السري لاكواد فيجوال بيسك 1968 والشفت ممكن به لا تحرمونا من الدعاء mobilesv.3-KSA.rar

السلام عليكم برنامج المطاعم قمت بتطويره اعتقد أنه أحد مشاركات الأستاذ القدير رمهان . وبالتوفيق مثال للاستفادة من الأفكار وسامحوني على تداخل الألوان كان على عجالة . أخوكم ومحبكم صالح البريكان أبوآمنة TestM.rar

- موديول إخفاء إطار الأكسس - التوسيط - التصغير بجوار الساعة - تغيير الأيقونة - استدعاء بيانات ورسائل من جدول تم وضع التذكيـــر الاتى برأس الموديول لسهولة التعامل مع الأكودا واستدعائها '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

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

بيانات الموظف ومرفقات منوعة للموظف الفيديو الصور

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

تفضل يمكنك استخدام هذا الكود 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

السلام عليكم ورحمة الله وبركاتة هذا مثال يتم من خلاله ربط الجداول برمجيا بدون تدخل من المستخدم عند فتح قاعدة الواجهات kaser906 يتم ربط الجداول بقاعدة جداول kaser906_be والقاعدة الثانية kasr9062 وكلتا القاعدتين مغفلتين برقم سري 1234 ضع المجلد في أي مكان او غير أسم المجلد وفتح قاعدة بيانات الواجهات kaser906 ستجد أن ربط الجداول تم بدون تدخل منك ::بالتوفيق للجميع :: TablLinkind.rar

الأمر بسيط تم التعديل على الملف واستخدام هذه المعادلة =IF(F4="","",(TODAY()-F4)+1)

تفضل لك ما طلبت-كما قلت لك سابقا لابد من ضبط تنسيق الرقم القومى مش عارف ليه الموضوع صعب كده معك يا استاذ على فقط كان عليك ضبط التنسيق مع تثبيت الجزء الموجود بالمعادلة الخاص بالصفحة الأخرى اى وضعه بين علامة الدولار كما تلاحظ المعادلة المفروض والصح تكون هكذا =IFERROR(VLOOKUP(A2,'رقم الموظف'!$A$1:$G$130,5,0),"") Pay-aht_moustafa-20190802-040908.xlsx Pay-mttks_magdi-20181011-082233-2019 - Copy.xls

تفضل تم عمل المطلوب project1.xlsx

طريقة سهلة لضبط الحجم اثناء التكبير والتصغير للنموذج تحافظ الايقونات على الحجم حيث تكبر وتصغر مع النموذج الخطوات : 1- جعل الايقونات مكدس 2- تصغير الحجم الى نصف نقطة عرض والى 1 من عشرة ارتفاع 3- جعل الارتساء الافقي والعامودي كلاهما 4- جعل النموذج منبثق 5- اختار يمكن تغيير حجمه وليس مربع حوار خدعة الضبط للنماذج.accdb

تفضل الكود داخل الملف #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

بعد اذن الأستاذ سليم -تفضل كود واحد يرحل جميع البيانات الى جميع الادارات وفق اسم الادارة ونوع المدرسة2.xlsm

اتفضل شرح بسرعة - جرب اضافة ملفاتك الصوتية قبل فتح البرنامج الى المجلد المرفق باسم sound files يا عينى ع الدلع APP_Player.zip

وعليكم السلام-اهلا بك في المنتدى -تفضل بلاغات.xlsm

السلام عليكم هدية متواضعه برنامج بسيط لتسجيل الديون المستحقة عليك ومتابعة تسجيل الدفعات الشهرية وكشف حساب اتمنى لكم الفائدة الديون .accdb

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

طريقة جديدة للبحث عن الاسم اتمنى لكم الفائدة search.accdb

بارك الله فيك ورحم الله والديك استاذنا الكريم

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

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

بعد اذن اساتذتى الكرام الاستاذ سليم والاستاذ احمد واثراء للموضوع جرب هذا الملف لعله يفى بالغرض نسخة من New Microsoft Excel Worksheet (2).xlsx

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

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

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

بعد اذن اخي علي معادلة بشكل ثاني =CHOOSE(AND(C1=D1,C1<>"",D1<>"")+1,"غير متزن","متزن")

الأمر في غاية البساطة عليك بعمل الخطوة التي تراها بالصورة

تفضل 1الأثاث.xlsm

بعد اذن اخي بن علية ثلاث حلول في 3 صفحات (تم تغيير الاسماء واختصار البيانات للتدقيق في صحة المعادلات) هناك حسب ما اعتقد حل رابع لم استطع معالجته لضيق الوقت اختر ما يناسبك Takrir.xlsx

على الرغم انك لم تقم الا برفع ملف خالى من البيانات ولم تقوم بشرح المطلوب عليه, الا وقد تم عمل المطلوب كما تريد , تفضل project.xlsx

هل يمكن لبرنامج اكسل ان يقوم بتقسيم الصورة علي مجموعة خلايا بنسبة مئوية معينة انظر لهذا الملف لتفهم ما أقصده Complete_picture.xlsx

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

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

أحسنت أستاذ وجيه معادلة ممتازة-بارك الله فيك

جرب الملف الأن تم التعديل ولا تظهر هذه الرسالة

ليس هناك مشكلة في هذا -أهم حاجة ان الملف يعمل بكل كفاءة

فقط عليك الضغط على Alt +F11 وفتح مديول جديد ووضع هذا الكود به مع تحديد الرينج المطلوب كما بالكود وربطه بالزر Sub Print1() Range("a2:b74").PrintOut End Sub

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

خطرت لي فكرة الأن ولم اجربها وهي النسخ لـ Google Drive أو Dropbox مثلا ........

وعليكم السلام-تفضل الأثاث.xlsm

لكن ما هذا

يارك الله فيك اخي علي وهذا كود اخر يعتمد على 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

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

تفضل بعد اذن الأستاذ رجب إخفاء الصفحات.xlsm

اذا اردتها عاموديا اكتب هذا المعادلة(اينما تريد) واسحبها نزولاً =ROWS($A$1:A1)*50 اذا اردتها افقياً اكتب هذا المعادلة(اينما تريد) واسحبها بالعرض =COLUMNS($A$1:A1)*50

ربما هذا مطلوبك ...... K_1.rar

=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 مع مراعاة ( الفاصلة والفاصلة المنقوطة _حسب اعادادات الجهاز عنكم)