نجوم المشاركات
Popular Content
Showing content with the highest reputation on 17 ينا, 2022 in all areas
-
السلام عليكم 🙂 زميلنا واخونا @ابو جودي بالاضافة الى كونه خبير ، اصبح احد اعضاء فريق عمل الموقع 🙂 1. شاركونا في تهنئته ، 2. وخلينا نساعده في مهمته الجديدة 🙂 ابو جودي ، اهلا وسهلا بك معنا مرة اخرى 🙂 جعفر5 points
-
السلام عليكم ورحمة الله اليك الملف جاهز كل ماعليك الضغط على الزر المكتوب عليه "اضغط للترحيل" فى ورقة data توزيع معدات واصناف علي شركات.xlsm3 points
-
السلام عليكم ورحمة الله استخدم هذا الكود Sub DistData() Dim ws As Worksheet, Sh As Worksheet Dim i As Long, p As Long, j As Long, LR As Long Dim Arr As Variant, Tmp As Variant Set ws = Sheets("data") Arr = ws.Range("A5:H" & ws.Range("B" & Rows.Count).End(3).Row).Value ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For Each Sh In Worksheets If Sh.Name <> ws.Name Then For i = 1 To UBound(Arr, 1) If Sh.Name = Arr(i, 6) Then p = p + 1 For j = 1 To 7 Tmp(p, j) = Arr(i, Choose(j, 1, 2, 3, 4, 6, 7, 8)) Next End If Next End If If p > 0 Then Sh.Range("A5").Resize(p, UBound(Tmp, 2)).Value = Tmp p = 0 Next End Sub3 points
-
هذا المطلب قد تطرق له من قبل اخي الاستاذ جعفر اطلب من اخواني واحبتي الاعزاء تكرما وتفضلا ان لا تكون الاجابة ضمن المرفق فقط مثلا بأن يقوم بالتعديل على المرفق ثم يرفعه فضرر هذه الطريقة فادح ويتضح في قادم الايام فيما لو تم حذف المرفق لاي سبب من الاسباب ومن المعلوم ان النصوص اكثر ثباتا وبقاء ايضا يصعب على من يعمل من هاتفه ويطلب المعلومة السريعة واعجبه السؤال ويحب الاطلاع على الحل فالمطلوب هو وجوب عرض الحل كنص سواء كان كود او شرح مبسط لما تم عمله الايضاح والشرح قد لا يتعدى سطرا واحدا .. ولكنه يجب ان يعطي تصورا صحيحا لطريقة الحل . بارك الله في اعمالكم وجهودكم وكتبها في موازين اعمالكم .2 points
-
انا عملته طبقا للصيغة الموجودة فعلا في الجدول وهذه الصيغة هي السائدة ، واستخدم التنسيق ( من اليمين الى اليسار ) في الواجهات2 points
-
مع ان الاولى تغيير حقل الهجري الى نص من اجل تجاوز التعارض مع الاشهر الشمسية الناقصة ولكن عند التحويل الى نص نفقد كثير من الخصائص التي تجرى على حقول التاريخ مشكلتك الحقيقة اخ عمر ان التاريخ الهجري يتم ادراجه في الجدول من اليسار الى اليمين والكود يقرأ من اليمين الى اليسار جرب لا تغير الحقل الى نصي بل اتركه كما هو واستبدل الكود بهذا Me.date_m = Um2Greg(Left(date_h, 2), Mid(date_h, 4, 2), Right(date_h, 4))2 points
-
لما تكون عندي معادلة بهذا التعقيد ، على طول وبدون تفكير ، اعمل وحدة نمطية واضع فيها المعادلة بطريقة مبسطة وبعدة اسطر ، ثم اناديها من الاستعلام 🙂 ننادي الدالة fOver_Time في الوحدة النمطية ، ونرسل لها البيانات المطلوبة OverTime: fOver_Time([ThisDay], [Dwam_Start], [Dwam_End], [txtStanderTimeOut1], [txtStanderTimeOut2]) . وهذه هي الدالة fOver_Time ، والتي يمكن تعديلها ببساطة : Public Function fOver_Time(TD, DS, DE, STO1, STO2) 'TD = [ThisDay] 'DS = [Dwam_Start] 'DE = [Dwam_End] 'STO1 = [txtStanderTimeOut1] 'STO2 = [txtStanderTimeOut2] If TD = "Friday" Then fOver_Time = DateDiff("n", DS, DE) \ 60 & ":" & DateDiff("n", DS, DE) Mod 60 ElseIf TD = "Thursday" Then fOver_Time = DateDiff("n", STO2, DE) \ 60 & ":" & DateDiff("n", STO2, DE) Mod 60 ElseIf TD <> "Friday" Or TD <> "Thursday" Then fOver_Time = DateDiff("n", STO1, DE) \ 60 & ":" & DateDiff("n", STO1, DE) Mod 60 End If End Function . جعفر2 points
-
يعطيكم الف عافيه وشكرا للاستاذ محمد حسن المحمد على الشرح بتمنى انها تزبط معي الطريقة وشكرا2 points
-
عدلها بهذا الشكل ... If ComPlat.Value = "Twitter" And Me.comType = "Click" Then TargetPlas.Value = [Forms]![PlatPrice]![NP1] * 0.5 ولكن .... ملاحظة يجب ان يكون النموذجين مفتوحين ......!!!!!!!2 points
-
انظر الى نوع حقل التاريخ الهجري في الجدول 🙂 الدالة UmDate_AfterUpdate هي المسؤولة عن طريقة عرض التاريخ ، فاذا اردت تغيير التنسيق ، فلا انصحك ان تغير في الدالة اعلاه ، ولكن خلينا نغير نتيجة الدالة: Private Sub date_h_AfterUpdate() UmDate_AfterUpdate If Not IsNull(date_h) Then 'Debug.Print Right(date_h, 2) 'Debug.Print Mid(date_h, 6, 2) 'Debug.Print Left(date_h, 4) Me.date_m = Um2Greg(Right(date_h, 2), Mid(date_h, 6, 2), Left(date_h, 4)) ''Me.date_m = Um2Greg(Right(date_h, 4), Mid(date_h, 6, 2), Left(date_h, 2)) 'Me.t_day = Format(Me.date_m, "dddd") Me.date_h = Right(Me.date_h, 2) & "/" & Mid(Me.date_h, 6, 2) & "/" & Mid(Me.date_h, 1, 4) '<== هذا السطر الاضافي لتغيير التنسيق End If End Sub . جعفر1 point
-
1 point
-
السلام عليكم 🙂 يجب ان نرى ما يراه الكمبيوتر ، ثم نتخذ قرار التصحيح ، اضف الاسطر الثلاثة في الكود ، ثم انظر في اسفل صفحة الكود immediate windows ، واخبرنا النتيجة: Private Sub date_h_AfterUpdate() UmDate_AfterUpdate If Not IsNull(date_h) Then Debug.Print Right(date_h, 2) Debug.Print Mid(date_h, 6, 2) Debug.Print Left(date_h, 4) Me.date_m = Um2Greg(Right(date_h, 2), Mid(date_h, 6, 2), Left(date_h, 4)) ''Me.date_m = Um2Greg(Right(date_h, 4), Mid(date_h, 6, 2), Left(date_h, 2)) 'Me.t_day = Format(Me.date_m, "dddd") End If End Sub . . جعفر1 point
-
1 point
-
استاذ عمر ... هناك مشاركات كثيرة لاستاذنا العزيز @jjafferr وهي مفيدة جدا .. وان اصبح لي الوقت اجمعها لفائدة الجميع لكني اصبح كسولا في بعض الاحيان لان البرمجة عندي هواية وليس مصدر للكسب1 point
-
1 point
-
1 point
-
1 point
-
مرحبا استاذ عمر ..حتى لا تدخل بمتاهات الحلقات التكرارية في النموذج المستمر..اليك هذا التعديل واسف عن التاخير بسبب المشاغل وبسبب ان الكيبورد تبعي (قافل معاي) حضور وانصراف موظفين_TestV31Q.accdb1 point
-
الف مبروك والله ربنا يكرمك يارب ويعينك على مهامك يارب كل تقديري واحترامي لك اخي الكريم1 point
-
الف . الف . الف ...... مبروك ....... تستاهل كل خير ... اعانك الله1 point
-
وعليكم السلام ورحمة الله وبركاته استاذنا الغالى ابو يوسف آمين يارب العالمين وإياكم اخى الغالى وجزاكم مثله استاذنا 🤲1 point
-
وعليكم السلام ورحمة الله وبركاته ضع هذه المعادله في العامود j واسحب المعادله لاسفل =If(D2="نقدى";H2;G2+H2) وان شاء الله تفي بالمطلوب1 point
-
عن نفسى بحاول اعمل كده اذا وفقت فى اجابة سؤال وفى المستقبل بإذن الله سنطبق هذه الطريقة قدر المستطاع .. جزاكم الله خير استاذنا الفاضل .1 point
-
الف مبروك ابو جودى ربنا يوفقك تفضل فى دوام وتميز أن شاء الله انت وباقى فريق العمل القائم على هذا الصرح العظيم1 point
-
السلم عليكم .. مبارك عليكم يا ابو جودى الله يعينك على المسئوليات الجديدة .1 point
-
مبارك علينا وعليك التميز والاضافة للمنتدى .... اعانك الله على المهام الجديدة ...1 point
-
الف مبروك @ابو جودي ومبروك علينا اسره واعضاء اوفيسنا 💐🌹 واسال الله تعالى ان يعينك ع هذه المسؤليه الجديده وانت لها ان شاء الله1 point
-
السلام عليكم ورحمة الله وبركاته من لم يشكر الناس لم يشكر أخي الحبيب @hassona229 جزاكم الله خيراً على تشجيعكم أسأل الله تعالى أن يحفظ لك ذريتك وأهلك وأن يكلأهم بعنايته ورعايته آمين. تقبل تحياتي العطرة 🙂1 point
-
السلام عليكم وأسعد الله مسائكم جميعا في مشكلة صغيرة ظهرت عندي عند تغيير اسم قاعدة البيانات يجب تغيير اسمها ايضاً في الملف الدفعي Register حسب ما ذكره استاذنا المبدع ابو جودي ولكن في مرة يتم اغلاق وإعادة فتح قاعدة البيانات يتغير اسمها في الملف الدفعي ويرجع E-Invoicing فهل هذا يؤثر على تشغيل قاعدة البيانات؟1 point
-
السلام عليكم ورحمة الله وبركاته مباركة عليكم أخي الحبيب @ابو جودي هذه المهمة التي أنتم أهل لمزاولتها - نحسبكم كذلك والله حسيبكم - كما نبارك لفريق الموقع بهذا النجم الساطع المليء حيوية ونشاطاً بفضل الله تعالى. تقبلوا تحياتي العطرة والسلام عليكم ورحمة الله وبركاته.1 point
-
1 point
-
استاذى ومعلمى ومروض اكسس الاستاذ / @ابو جودي مبارك عليك المركز والوضع الجديد فى المنتدى فعلا تشتاهل كل خير لتعبك معنا جميعا الف مبروك وعقبال الوزارة يارب (طبعا وزارة البرمجة)1 point
-
السلام عليكم ألف ألف مبارك أخي @ابو جودي بارك الله فيك وادامك ذخر للمنتدى1 point
-
لهذا السبب ، لا استغنى عن البرنامج في الرابط ، كلما عملت اضافات على البرنامج اللي اشتغل عليه ، استعمل برنامج الرابط حتى اعرف انه لا توجد به اخطاء ، ويعمل نسخة منه ، خطوة بخطوة 🙂 . جعفر1 point
-
أهلا بك أبا جودي في الفريق العمل.. عضو فاعل وصاحب مبادرات غير مسبوقة.. أتمنى لك مزيدا من التألق والعطاء..1 point
-
اتمنى لك دوام التوفيق والنجاح يا أستاذ أبا جودي تستاهل كل خير والله يعينك ويسهل أمورك 😊1 point
-
Sub Test() Dim arr, v1, v2, coll As New Collection, s As String, max As Long, i As Long, j As Long Application.ScreenUpdating = False arr = Sheets("MP1").Range("A1").CurrentRegion.Value For i = 1 To UBound(arr, 1) s = CStr(arr(i, 1)) On Error Resume Next coll.Add Key:=s, Item:=New Collection On Error GoTo 0 If coll(s).Count = 0 Then coll(s).Add s If arr(i, 5) > 0 Then coll(s).Add CStr(arr(i, 2)) Next i For Each v1 In coll If v1.Count > max Then max = v1.Count Next v1 ReDim arr(1 To coll.Count, 1 To max) i = 0 For Each v1 In coll i = i + 1 j = 0 For Each v2 In v1 j = j + 1 arr(i, j) = v2 Next v2 Next v1 For j = 2 To max arr(1, j) = j - 1 Next j With Sheets("Result").Range("A1") .CurrentRegion.Clear .Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr With .CurrentRegion .EntireColumn.AutoFit .Borders.Value = 1 End With End With Application.ScreenUpdating = True End Sub Create a worksheet and name it "Result" first before running the code1 point
-
كل ما عليك فعله هو تغيير مصدر السجل للنموذج فقط! ملاحظة هامة: هذى المشاركة والتي قبلها مخالفة لأنظمة وقواعد المشاركة.. ولذا إذا كنت ستسمر في طرح الأسئلة رجاءً قم بفتح مشاركة جديدة مع الإشارة إلى هذه الجزئة..1 point
-
نعم .. طريقة البحث ممتازة، لا سيما وأنه يبحث داخل الـ (comboBox) نفسه وليس عبر مربع نص خارجي، ثم يخرج النتائج مع التغيير أثناء الكتابة وليس بعد التحديث أو عند الخروج أما بخصوص التنقل بين النتائج، فقد تمكنت بفضل الله من حل هذه المشكلة بوضع هذا الكود في حدث (عند مفتاح للأسفل) If KeyCode = 40 And Shift = 0 Or KeyCode = 38 And Shift = 0 Then G = 1 End If مع إضافة بسيطة في أول كود البحث كما في الملف المرفق فأصبح يتنقل بين النتائج باستخدام مفتاحي: للأعلى وللأسفل فأرجو أن يكون تصرفي هو الحل الصحيح ولدي ملاحظة أخرى بخصوص هذا الكود: فهو يبحث عن الحروف حتى لو كانت متتالية في أكثر من كلمة، وبالنسبة لي فالمطلوب البحث عن الحروف متتابعة أو متلاصقة في نفس الكلمة يعني عند طلب البحث عن (زج) تخرج النتائج بهذا الشكل والنتيجة الأخيرة غير مطلوبة بالنسبة لي، ولكنه يبحث عن الحروف المدخلة حتى إذا لم تكن متتابعة في نفس الكلمة، لذلك أخرج النتيجة الأخيرة لأنه وجد حرف (ز) في كلمة (زاهد) ثم وجد حرف (ج) في كلمة (للتجارة) وهذه الطريقة في البحث قد تناسب غيري بل قد تكون بغيته المنشودة، لكن بالنسبة لي فالنتيجة المطلوبة هي وتمكنت بفضل الله من الوصول إليها بعد عدة تجارب ومحاولات في حذف بعض أسطر الكود .. حذفتها من باب التجربة لأني بصراحة لا أعلم ماذا تعني ؟؟ 😅 فلست من أهل الاختصاص وإنما من أهل التجارب والمحاولات 🙂 ونتيجة هذه التجارب في نموذج (Search_combo 2) في نفس الملف المرفق، لعل أحد الإخوة من ذوي الخبرة ينظر فيه ويعطينا رأيه .. لأني عندما طبقت هذا الكود في قاعدة بياناتي واجهتني بعض المشاكل البسيطة في تظليل الكلمة المدخلة في مربع البحث .. فقد تكون هناك طريقة أفضل للوصول للمطلوب: البحث عن الحروف متتابعة في نفس الكلمة Search_inside_Combo X.accdb1 point
-
1 point
-
بارك الله فيكم اخوتي واحبتي ، واحسن اليكم . لمدكم يد العون لأخيكم في شرحك الاخير اخ عمر اتضحت الصورة تماما .1 point
-
1 point
-
السلام عليكم أخي @ابايوسف من خلال البحث تبين لي ما يلي: بيانات المستخدم USER LOGIN INFORMATION USER NAM - إسم المستخدم 123 PASSWORD - كلمة المرور 123 يمكن من خلاله الدخول إلى البرنامج1 point
-
1 point
-
اللأخ الكريم -محمد-حسن-المحمد تحية لكم توضحت الصورة بشكل جيد لك جزيل الشكر و التقدير1 point
-
السلام عليكم أخي الكريم @احمد غانم لاحظ أخي الكريم أن الكود يعطيك النتائج كما يلي: 1- النتيجة الموجبة يكتب لك : فقط ........... 2- النتيجة السالبة يكتب: يتبقى لكم ............. 3- القيمة الصفرية يكتب لك : صفر لا أدري ما هو التغيير الذي تطلبه ...يرجى الإيضاح هل تعني مثلاً إن كانت النتيجة سالبة يرجع لك النتيجة صفر أم ماذا؟!.. تقبل تحياتي1 point
-
1 point
-
بالنسبة لحقل الملاحظات استخدم الملاحظات الموجودة في الجداول الفرعية وليس الجدول الأصلي .. الجدول الأصلي به حقل ملاحظات ولكنه غير مستغل يمكنك إضافته في النموذج الأساسي ..1 point
-
شكلي ما وضحت لك فكرة الكود بالشكل المطلوب 😅 كتبته بسرعة بدون تفاصيل ، وهذا كان المقصود ( روتين واحد لكل السورس أوبجكت ) : Sub DocmdMnu(FrmName As String) Me.frmSub.SourceObject = FrmName End Sub Sub GoDo(ByRef ActiveControlName As String) Select Case Nz(ActiveControl.Name, "") Case Is = "cmdMnu1": DocmdMnu ("frmEmployees") Case Is = "cmdMnu2": DocmdMnu ("Table.tblStudents") Case Is = "cmdMnu3": DocmdMnu ("Table.tblAdministrativeforms") Case Is = "cmdMnu4": DocmdMnu ("Table.tblStudentOffenses") Case Is = "cmdMnu5": DocmdMnu ("Table.tblStatements") Case Is = "cmdMnu6": DocmdMnu ("Table.tblRecords") Case Is = "cmdMnu7": DocmdMnu ("Table.tblDataimport") Case Is = "cmdMnu8": DocmdMnu ("Table.tblCertifications") Case Is = "cmdMnu9": DocmdMnu ("Table.tblPhoneBook") Case Is = "cmdMnu10": Me.frmSub.SourceObject = "" '"Table.tblSystemConstants" DoCmd.OpenForm "frmEmployees" Case Is = "cmdMnu11": Me.frmSub.SourceObject = "" ': Me.frmSub.Visible = False: MsgBox "Welcome to our world of www.officena.net" DoCmd.Close acForm, Me.Name End Select End Sub تم التعديل في المرفق التالي : إبداعات أبا جودي.rar1 point
-
1 point