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

You can click on LIKE button if the code solved your problem

السلام عليكم بالنسبة إلى السطر الأحمر: فهو متعلق بنواة الويندوز، وقد اقتبسته من موضوع للأستاذ @jjafferr وفيه تفصيل عن سبب وجود هذا اللون الأحمر. بالنسبة إلى الطريقة: من الغريب، أنكم لم تلاحظوا أن الكاركترز واللون يمكن تغييرهما، وتستطيع تنفيذ الكود لمرة واحدة أو إقرانه بأزرار، وبشرط ديناميكي، أما النموذج والموديول: فتستطيع استيرادها إلى كل برنامج تقوم به، وطالما أن تسميات العناصر واحدة في برامجك فلن تحتاج إلى التعديل على الكود. شاهد المرفق بإمعان، فما قد تستصعب التأمل به لدقائق، قد استغرق ساعات من التفكير والعمل لموضوع غير مسبوق عندي. أللهم صل على سيدنا محمد وعلى آله وصحبه وسلم

لا أضاع الله تعبك وجهدك أستاذ @Khalf .. فعلا حل ذكي! مع بساطته وسهولته.. وأشهد أنه أحد نوادرك.. شكراً لك..

In worksheet module Private Sub Worksheet_Change(ByVal Target As Range) Dim x If Target.Address = "$A$1" Then Columns("B:AT").Hidden = False If Target.Value = Empty Then Target.Select: Exit Sub x = Application.Match(Target.Value2, Rows(3), 0) If Not IsError(x) Then Columns("B:AT").Hidden = True Columns(x).Hidden = False End If Target.Select End If End Sub

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

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

سؤالك غير واضح كيف يعطي و اين يكون العطاء لرقم الحساب و اين هو جدول الحسابات كذلك هنا نفس الكلام هل تريد نموذج تسجيل فروع جديدة و اقسام للشجرة ؟

تفضل هذا الكود Dim msg1, msg2 As String msg2 = "عزيزي المستخدم " & vbNewLine & "يرجى تعبئة الحقل / الحقول الفارغة" Dim ctl As Control For Each ctl In Me.Controls If TypeName(ctl) = "TextBox" Then If IsNull(ctl) Or ctl = "" Then If msg1 = "" Then msg1 = " - " & ctl.Name Else msg1 = msg1 & vbNewLine & " - " & ctl.Name End If End If End If Next ctl If msg1 = "" Then DoCmd.RunCommand acCmdSaveRecord MsgBox "تم الحفظ بنجاح", vbInformation, "تأكيد" Else MsgBox msg2 & vbNewLine & msg1, vbCritical, "تنبيه بوجود حقول فراغة" End If مرفق الملف بعد التعديل hamza.zip

وعليكم السلام ورحمة الله وبركاته تفضل جرب هذا book1 معدل.xlsx

النواة الواحدة لا تعرف شيء عن النواة الاخرى ، ولكن لطالما اشتغل الكود بدون اخطاء ، فهذا معناه اترك السطر باللون الاحمر لحاله 🙂 انا لاحظت نموذج اختيار الالوان ، وطريقة حفظ رقم اللون في الجدول (الاهم انك لم تحفظه عن طريق RGB ، وإلا لن تستطيع الاستفادة منه مباشرة في الكود ، دون تفكيك الالوان) ، ومناداته من هناك ، وطريقة الاكواد وعمل الوحدة النمطية كان ذكي 🙂 في الواقع عمل نظيف 🙂 وكذلك لاحظت وجود بعض الوحدات التي تحتاج تنظيف وازالة 😁 جعفر

السلام عليكم ورحمة الله استخدم المعادلة التالية =COUNTIF(A1:A100;"?*")

اظن المشكلة فى هذا السطر .. ماهى Conect ؟ مش متعرفة كمتغير و مش شايف لها استخدم فى الكود الحالى اظنها Function يتم استدعاءها بشرط صحة بيانات الدخول ؟ عامة الغيها حاليا من الكود ليصبح هكذا وجرب Private Sub LogIN_Click() On Error Resume Next MyUserName = Me.MyUser_Name MyPassword = Me.MyPassword Dim db As DAO.Database Dim rs As DAO.Recordset Dim qr As QueryDef Dim sql As String Set db = CurrentDb sql = "select * from [users] where User_Name=[MyUserName] and User_Password=[MyPassword]" Set qr = db.CreateQueryDef(vbNullString, sql) With qr .Parameters("MyUserName") = MyUserName .Parameters("MyPassword") = MyPassword .ReturnsRecords = True Set rs = .OpenRecordset() End With If Not rs.EOF Then 'conect = True If rs.Fields("User_Active") = 0 Or DateFormat(rs.Fields("DateEnd")) < DateFormat(Now) Then MsgBox "انتهى تنشيط هذا المستخدم", vbExclamation + vbOKOnly + vbMsgBoxRight, "تنبيه" Else MyUser_NO = rs.Fields("User_NO") MyUserName = rs.Fields("User_Name") DoCmd.Close acForm, "LogIn", acSaveYes DoCmd.OpenForm "Form1" End If Else 'conect = False MsgBox "معلومات دخول غير صحيحة", vbCritical + vbOKOnly + vbMsgBoxRight, "تنبيه" End If End Sub

السلام عليكم هذا ما تحتاج وتبحث عنه إن شاء الله أللهم صل على سيدنا محمد وعلى آله وصحبه وسلم لا إله إلا الله وحده لا شريك له، له الملك وله الحمد يحيي ويميت وهو على كل شيء قدير Colorizing.accdb

تفضل التعديل قاعدة بيانات HR.accdb

لله درك اخى الكريم جزاك الله خير الجزاء على مساندتى وقتما طلبت منك فجعلك الله خير عون لى على انجاز عملى على افضل وجه اخوك احمد محمود

رائع ، شكرا

اشكرك استاذي لا لا يوجد تقسيم للقاعدة هى القاعدة موجودة على جوجل درايف بفتحها من جهازين واحد يشتغل والاخر لا بارك الله فيك اخى

سؤال آخر لو سمحت .. عندك جهازين واحد القاعدة مقسمة وموجودة على الجهاز وهذه القاعدة تعمل بدون مشاكل ؟ والآخر بالعمل والقاعدة مقسمة ولكن الجداول على جووجل درايف وهذه النسخة اللى بتظهر الخطأ الموجود بالصورة ؟ لو صح الكلام فيه احتمال بعيد ولكن على سبيل التجربة لن يضر .. هل تأكدت ان مجلد جووجل درايف صلاحياته Read And Write ؟ ممكن يكون Read Only ولذلك عملية الاتصال بالقاعدة لا تتم وبسببه بيطلع مشكلة بالكود انه مش قادر يتصل ؟ مجرد احتمال فقط وفى انتظار قاعدتك للتجربة واختبار الاكواد بها .. بالتوفيق

لو ترفق قاعدة مصغرة المشكلة قائمة بها يبقى افضل وسنجد الحل بإذن الله

سؤالك مكرر و تمت الاجابة عليه سابقاً شكرا لك

و عليكم السلام و رحمة الله وبركاته هل هذا سؤال او معلومة ؟

السلام عليكم موجود في المنتدي ما يرد علي سؤالك انظر الموضوع الاتي

تفضل التعديل system.zip

Sub Test() Dim a, temp, dict As Object, buy As Double, sell As Double, i As Long, x As Long Set dict = CreateObject("Scripting.Dictionary") With Sheets("Sheet1").Cells(2).CurrentRegion a = .Value: ReDim temp(1 To UBound(a), 1 To 3) For i = 2 To UBound(a) If Not dict.Exists(a(i, 1)) Then dict.Add a(i, 1), "" buy = Application.WorksheetFunction.SumIfs(.Columns(7), .Columns(1), a(i, 1), .Columns(2), "BUY") sell = Application.WorksheetFunction.SumIfs(.Columns(7), .Columns(1), a(i, 1), .Columns(2), "SELL") If buy > sell Then x = x + 1: temp(x, 1) = a(i, 1): temp(x, 2) = buy: temp(x, 3) = sell End If Next i End With With Sheets("Sheet2") .Columns(1).ClearContents .Range("A2").Value = "Market" .Range("A3").Resize(x, 1) = temp End With End Sub

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

السلام عليكم ورحمة الله وبركاته ضع في الخلية E14 واسحب نزولاً =IFERROR(IF($D$8=D14;"";IF($D$8<D14;0;$D$8-D14));"") تقبل تحياتي كيف كانت النتيجة؟...😊

وعليكم السلام اليكم الحل بعمودين مساعدين مساعدة++.xlsx

ارسل ملفك هنا للتعديل عليه

السلام عليكم عزيزي @palesten ارجوا منك المعذرة ... انا ا مريض جدا ولا استطيع التركيز ارجوا من بقية الاخوة مساندتك

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

السلام عليكم ورحمة الله وبركاته ضع في الخلية FB6 واسحب نزولاً تقبل تحياتي كيف كانت النتيجة؟...😊 =IF(B6="";"";SUM(FA6;EV6;EQ6;EL6;EG6;EB6;DW6;DR6;DM6;DH6;DC6;CX6;CS6;CN6;CI6;CD6;BY6;BT6;BO6;BJ6;BE6;AZ6;AU6;AP6;AK6;AF6;AA6;V6;Q6;L6;G6))

مرحباً أخي @abouelhassan لا أستطيع وصف الحل فالمشكلة غير واضحة، ولا أعلم المكتبة المطلوبة أما عن الإضافة بصورة عامة فمن

ما شاء الله عليك اخي ابو حبيبة ... تفهمها وهي طااااايرة

السلام عليكم اخي أبوعيد ... شكرا لك ... تم المطلوب استكمالا لموضوع اخي alliiia ... حدد TextBox ... ثم اذهب لشريط الصيغة واكتب k5= حتى يتم الربط بين البيانات الموجودة في الخلية ومربع النص

تفضل جرب هذا k.sمعدل.xlsx

Put the following line before the line of Next Next Should be If [E13] = 0 Then Exit For ActiveWindow.SelectedSheets.PrintOut Copies:=1 Next

تفضل جرب هذا مقارنة معدل.xlsx

لم افهم ماذا تريد ؟ ماهو المطلوب تحديداً لكي نقدم لك المساعدة.

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

هذه النسخة الأخيرة من التعديل أرجو أن تكون فيها فائدة للجميع.. وأعتذر للجميع بإغلاق المشاركة.. Dashboard2003.mdb

أهلابك.. نعم يمكن.. انسخ السطر المتعلق بالزر والذي أشرت إليه أعلا وسوف يأخذ نفس الخصائص Dashboard2003.mdb

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