كل الانشطه

شكرا جزيلا تم حل المشكله بارك الله فيك

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

السلام عليكم واسعد الله اوقاتكم بكل خير المشكلة : بعد الانتهاء من عمل قاعدة لعميل يطلب نسخة للتجربة, ارسل له نسخه تجريبية فيقوم بتسجيل البيانات مثلا قام بإدخال 20 سجلا بعد ذلك يطلب النسخه الكامله ويضطر إلى اعادة ادخال البيانات من جديد الفكرة : خطرت لي فكرة اولا استبعاد فكرتي القديمة وهي الاعتماد على تاريخ معين ثم بعد ذلك يتوقف البرنامج وكذلك يتم تفعيل النسخه دون الحاجه إلى ارسال نسخه جديده واعتماد فكرة ان العميل يقوم بادخال عدد من السجلات ثم بعد ذلك يتوقف الادخال (تقييد السجلات بعدد معين) بعد الوصول لعدد السجلات المتاحه يظهر (INBUTBOX) تفيد بأن النسخه للتجربة للاستمرار يرجى ادخال رمز التفعيل عندما يتم ادخال الرمز الصحيح يستمر البرنامج بالعمل .. مع ملاحظة ما يلي : 1- التفعيل يتم عن طريق ريجستري الجهاز 2- رمز التفعيل لا يتم حفظه في جدول وإنما داخل الكود لتأمينة التطبيق : 1- اضافة هذا المديول في قاعدتك ' التحقق من التفعيل Public Function IsActivated() As Boolean On Error Resume Next IsActivated = GetSetting("MyApp", "Activation", "Activated", "False") = "True" End Function ' تفعيل البرنامج Public Sub ActivateSoftware(pw As String) If pw = "1020" Then SaveSetting "MyApp", "Activation", "Activated", "True" MsgBox "تم تفعيل النسخة بنجاح يمكنك الاستمرار في ادخال السجلات!", vbInformation Else MsgBox "كلمة مرور خاطئة!", vbCritical End If End Sub 2- في نموذج ادخال البيانات عند حدث قبل الادراج اضف : If IsActivated() Then Exit Sub Dim recordCount As Long recordCount = DCount("*", "t1") If recordCount >= 3 Then Dim pw As String pw = InputBox("هذه نسخة للتجربة. يرجى التواصل لطلب رمز التفعيل:", "تفعيل النسخة") Call ActivateSoftware(pw) If Not IsActivated() Then Cancel = True End If End If مرفق لكم التجربه ونستقبل افكاركم الجميله لتحسين هذه الفكرة تقييد النسخه بعدد سجلات محدده.accdb

أسعدكم الله أخي @Hamtoooo ، وبإذن الله قريباً جداً مميزات وتحسينات وإضافات جديدة ترقى بكم وبهذا المنتدى .

شكرا جزيلا علي الرد ولكن النتائج بتظر بهذا الشكل لا أدري أين المشكله

شكرا جزيلا أخي الفاضل وبارك الله فيك وأكثر الله من أمثالك وزادك الله من علمه ساجرب وأوافيك بالنتيجة

في التحديث الجديد تم إضافة ميزات وتحسينات كثيرة إن شاء الله 😇 . قريباً بإذن الله

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

عمل جميل تشكر عليه ملاحظتي البسيطه واعتقد انك تستطيع حل هذه المشكله وهو عندما اريد ارسال رساله عن طريق ادخال الرقم مباشره او عن طريق السجل يبدو لي ان العمل يكون اكثر سلاسه وتجنبا للأخطاء هو : انه عندما نقوم بادخال الرقم 055555555 واضف الصفر اليس من الافضل ان يقوم البرنامج بحذف الصفر تلقائيا ويقوم بادراج +966 مثلا سواء بادخال الرقم مباشره او عندما اضيفه في سجل تجنبا للاخطاء

وعليكم السلام ورحمة الله وبركاته.. في زر *اعرض هذا الملف* ، ثم الزر "حمل هذا الملف*

و عليكم السلام ورحمة الله و بركاته جرب الكود التالي Sub CalculateGenderStats() Dim wsMain As Worksheet Dim wsGender As Worksheet Set wsMain = ThisWorkbook.Sheets("Sheet_Main") Set wsGender = ThisWorkbook.Sheets("Gender Male Female") Dim LastRowMain As Long LastRowMain = wsMain.Cells(wsMain.Rows.count, "A").End(xlUp).Row ' متغيرات للحوالات المصدرة (من العمود I - نوع الراسل) Dim SentMales As Long, SentFemales As Long, SentUnknown As Long Dim SentMalesAmount As Double, SentFemalesAmount As Double, SentUnknownAmount As Double Dim SentMalesClients As Object, SentFemalesClients As Object, SentUnknownClients As Object Set SentMalesClients = CreateObject("Scripting.Dictionary") Set SentFemalesClients = CreateObject("Scripting.Dictionary") Set SentUnknownClients = CreateObject("Scripting.Dictionary") ' متغيرات للحوالات المصروفة (من العمود S - نوع المرسل إليه) Dim PaidMales As Long, PaidFemales As Long, PaidUnknown As Long Dim PaidMalesAmount As Double, PaidFemalesAmount As Double, PaidUnknownAmount As Double Dim PaidMalesClients As Object, PaidFemalesClients As Object, PaidUnknownClients As Object Set PaidMalesClients = CreateObject("Scripting.Dictionary") Set PaidFemalesClients = CreateObject("Scripting.Dictionary") Set PaidUnknownClients = CreateObject("Scripting.Dictionary") Dim i As Long Dim ClientName As String, Gender As String, NationalID As String Dim Amount As Double ' --- تحليل الحوالات المسحوبة (الصادرة) --- For i = 2 To LastRowMain ClientName = Trim(wsMain.Cells(i, "A").Value) NationalID = Trim(wsMain.Cells(i, "B").Value) Gender = Trim(wsMain.Cells(i, "I").Value) Amount = 0 If IsNumeric(wsMain.Cells(i, "F").Value) Then Amount = wsMain.Cells(i, "F").Value ' تجاهل الصفوف الفارغة If ClientName <> "" And NationalID <> "" Then Select Case Gender Case "ذكر" SentMales = SentMales + 1 SentMalesAmount = SentMalesAmount + Amount If Not SentMalesClients.Exists(NationalID) Then SentMalesClients.Add NationalID, 1 Case "أنثى" SentFemales = SentFemales + 1 SentFemalesAmount = SentFemalesAmount + Amount If Not SentFemalesClients.Exists(NationalID) Then SentFemalesClients.Add NationalID, 1 Case Else SentUnknown = SentUnknown + 1 SentUnknownAmount = SentUnknownAmount + Amount If Not SentUnknownClients.Exists(NationalID) Then SentUnknownClients.Add NationalID, 1 End Select End If Next i ' --- تحليل الحوالات المصروفة --- For i = 2 To LastRowMain ClientName = Trim(wsMain.Cells(i, "K").Value) NationalID = Trim(wsMain.Cells(i, "L").Value) Gender = Trim(wsMain.Cells(i, "S").Value) Amount = 0 If IsNumeric(wsMain.Cells(i, "N").Value) Then Amount = wsMain.Cells(i, "N").Value ' تجاهل الصفوف الفارغة If ClientName <> "" And NationalID <> "" Then Select Case Gender Case "ذكر" PaidMales = PaidMales + 1 PaidMalesAmount = PaidMalesAmount + Amount If Not PaidMalesClients.Exists(NationalID) Then PaidMalesClients.Add NationalID, 1 Case "أنثى" PaidFemales = PaidFemales + 1 PaidFemalesAmount = PaidFemalesAmount + Amount If Not PaidFemalesClients.Exists(NationalID) Then PaidFemalesClients.Add NationalID, 1 Case Else PaidUnknown = PaidUnknown + 1 PaidUnknownAmount = PaidUnknownAmount + Amount If Not PaidUnknownClients.Exists(NationalID) Then PaidUnknownClients.Add NationalID, 1 End Select End If Next i ' --- إجماليات --- Dim TotalSent As Long, TotalPaid As Long Dim TotalSentAmount As Double, TotalPaidAmount As Double TotalSent = SentMales + SentFemales + SentUnknown TotalPaid = PaidMales + PaidFemales + PaidUnknown TotalSentAmount = SentMalesAmount + SentFemalesAmount + SentUnknownAmount TotalPaidAmount = PaidMalesAmount + PaidFemalesAmount + PaidUnknownAmount ' --- كتابة النتائج في ورقة Gender Male Female --- ' عناوين الجدول الأول (الحوالات المصدرة) With wsGender .Range("A4:G4").Value = Array("بيان التعاملات", "عدد العمليات", "نسبة العمليات", "عدد عملاء", "نسبة العملاء", "إجمالي المبالغ", "نسبة المبالغ") ' بيانات الذكور (الصادرة) .Range("A5").Value = "ذكر" .Range("B5").Value = SentMales .Range("C5").Value = IIf(TotalSent > 0, SentMales / TotalSent, 0) .Range("D5").Value = SentMalesClients.count .Range("E5").Value = IIf((SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count) > 0, SentMalesClients.count / (SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count), 0) .Range("F5").Value = SentMalesAmount .Range("G5").Value = IIf(TotalSentAmount > 0, SentMalesAmount / TotalSentAmount, 0) ' بيانات الإناث (الصادرة) .Range("A6").Value = "انثي" .Range("B6").Value = SentFemales .Range("C6").Value = IIf(TotalSent > 0, SentFemales / TotalSent, 0) .Range("D6").Value = SentFemalesClients.count .Range("E6").Value = IIf((SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count) > 0, SentFemalesClients.count / (SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count), 0) .Range("F6").Value = SentFemalesAmount .Range("G6").Value = IIf(TotalSentAmount > 0, SentFemalesAmount / TotalSentAmount, 0) ' بيانات غير المحدد (الصادرة) .Range("A7").Value = "غير محدد" .Range("B7").Value = SentUnknown .Range("C7").Value = IIf(TotalSent > 0, SentUnknown / TotalSent, 0) .Range("D7").Value = SentUnknownClients.count .Range("E7").Value = IIf((SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count) > 0, SentUnknownClients.count / (SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count), 0) .Range("F7").Value = SentUnknownAmount .Range("G7").Value = IIf(TotalSentAmount > 0, SentUnknownAmount / TotalSentAmount, 0) ' الإجمالي (الصادرة) .Range("A8").Value = "الاجمالى" .Range("B8").Value = TotalSent .Range("C8").Value = 1 .Range("D8").Value = SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count .Range("E8").Value = 1 .Range("F8").Value = TotalSentAmount .Range("G8").Value = 1 ' عناوين الجدول الثاني (الحوالات المصروفة) .Range("A10:G10").Value = Array("بيان التعاملات", "عدد العمليات", "نسبة العمليات", "عدد عملاء", "نسبة العملاء", "إجمالي المبالغ", "نسبة المبالغ") ' بيانات الذكور (المصروفة) .Range("A11").Value = "ذكر" .Range("B11").Value = PaidMales .Range("C11").Value = IIf(TotalPaid > 0, PaidMales / TotalPaid, 0) .Range("D11").Value = PaidMalesClients.count .Range("E11").Value = IIf((PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count) > 0, PaidMalesClients.count / (PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count), 0) .Range("F11").Value = PaidMalesAmount .Range("G11").Value = IIf(TotalPaidAmount > 0, PaidMalesAmount / TotalPaidAmount, 0) ' بيانات الإناث (المصروفة) .Range("A12").Value = "انثي" .Range("B12").Value = PaidFemales .Range("C12").Value = IIf(TotalPaid > 0, PaidFemales / TotalPaid, 0) .Range("D12").Value = PaidFemalesClients.count .Range("E12").Value = IIf((PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count) > 0, PaidFemalesClients.count / (PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count), 0) .Range("F12").Value = PaidFemalesAmount .Range("G12").Value = IIf(TotalPaidAmount > 0, PaidFemalesAmount / TotalPaidAmount, 0) ' بيانات غير المحدد (المصروفة) .Range("A13").Value = "غير محدد" .Range("B13").Value = PaidUnknown .Range("C13").Value = IIf(TotalPaid > 0, PaidUnknown / TotalPaid, 0) .Range("D13").Value = PaidUnknownClients.count .Range("E13").Value = IIf((PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count) > 0, PaidUnknownClients.count / (PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count), 0) .Range("F13").Value = PaidUnknownAmount .Range("G13").Value = IIf(TotalPaidAmount > 0, PaidUnknownAmount / TotalPaidAmount, 0) ' الإجمالي (المصروفة) .Range("A14").Value = "الاجمالى" .Range("B14").Value = TotalPaid .Range("C14").Value = 1 .Range("D14").Value = PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count .Range("E14").Value = 1 .Range("F14").Value = TotalPaidAmount .Range("G14").Value = 1 ' الإجمالي العام (من B15 إلى G15) .Range("A15").Value = "الإجمالى العام" .Range("B15").Value = TotalSent + TotalPaid .Range("C15").Value = 1 ' النسبة الكلية دائمًا 100% .Range("D15").Value = SentMalesClients.count + SentFemalesClients.count + SentUnknownClients.count + PaidMalesClients.count + PaidFemalesClients.count + PaidUnknownClients.count .Range("E15").Value = 1 .Range("F15").Value = TotalSentAmount + TotalPaidAmount .Range("G15").Value = 1 End With ' --- تنسيق النسب كنسبة مئوية --- With wsGender .Range("C5:C8, G5:G8").NumberFormat = "0.00%" .Range("C11:C14, G11:G14").NumberFormat = "0.00%" .Range("C15, G15").NumberFormat = "0.00%" .Range("F5:F8, F11:F14, F15").NumberFormat = "#,##0.00" End With MsgBox "تم تحديث تقرير النوع بنجاح!", vbInformation End Sub النسخه النهائيه(2).xlsm

تحية طيبة أستاذنا @ابوخليل معذرة على التأخر في الرد بعد تجربة الكود شغال و يؤدي المطلوب - طريقة جيدة- ربما أنا فقط تعودت كثيرا على استعمال الفلترة بواسطة هذا الكود الجميل لأستاذنا @Foksh في هذا الموضوع أفهم من كلامك أستاذنا أن الفلترة غير ممكنة (إظهار سجل المعني بالبحث لوحده) جزاك الله كل الخير أستاذنا @ابوخليل وجعلها في ميزان حساناتك سيتم استعمال كود البحث هذا في النماذج المشابهة لهذا المبدأ كما اشكر كثيرا كذلك أستاذنا @Foksh و ربي يبارك في هذا المنتدى الجميل

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

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

وعليكم السلام ورحمة الله وبركاته .. أولاً أخي الكريم ما علاقة النموذج الفرعي في حدث القرير !!!!! حاول ان يكون العنوان ذا صلة بالموضوع وأن يكون واضحاً . راجع هذا الموضوع ، سيفيدك كثيراً . فهو يحتوي ثمرة خبرة الأساتذة في هذا الموضوع

تفضل Data129.rar

اذا فكلامي صحيح .. وكما توقعته منك انت تعمل حسب علمك ومعرفتك البرمجية .. وهذا خطأ المفروض تعمل حسب فكرك وخيالك الم تلاحظ اني احيانا اطرح اسئلة واطلب المساعدة .. ربما بعض الاستفسارات عادية .. وحلها معروف بالضرورة .. ومع ذلك اسعى الى مشاركة العقول والافكار .. ربما احصل على حلول وافكار لم تخطر على البال . المهم : الآن .. الحل او الفكرة التي عندي لتحقيق مطلبك بعد مراجعة المشروع جيدا : 1- تقرير واحد فقط .. يحقق مطالبك الاربعة 2- بدون اي استعلامات جديدة هل هذا ممكن ؟ نعم .. لأن الاستعلامات موجودة فعلا في المشروع . انتظرني ،،،

كملت وبقى سكه داله عامة وكود مصغر Private Sub ActiveXCtl63_Click() '===( مصدر التقسيم من النموذج الحالي) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم , سحب الفلترة من التنموذج الحالي) Call OpenPagedReportWithFilter("D_1", "frm_1", "العملاء", 100, "A7") End Sub Private Sub ActiveXCtl64_Click() '===( مصدر التقسيم من الاستعلام) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم) Call OpenPagedReport("frm_1", Me.db.Caption & "_SQL_Date_1", 100, "A7") End Sub Private Sub ActiveXCtl65_Click() '===( مصدر التقسيم من الاستعلام) '===================(حقل الترقيم , عدد التقسيم , اسم الجدول او الاستعلام , اسم النموذج كماهو لفتح التقرير وعبار عن ادوات التحكم) Call OpenPagedReport("frm_1", Me.db.Caption & "_SQL_Date_2", 100, "A7") End Sub

السلام عليكم اريد عند ادخال هذا الكود في النموذج الفرعي تظهر لا توجد بيانات اليكم الكود الشه.rar

اخي عند تحميل النموذج يتم حجز السجلات المصدر .. وليس كل عملية بحث تتنفذ مثل الفلتر ومثل المعايير في الاستعلام لذا يجب ان تبحث عن طرق اخرى للبحث وهي كثيرة اليك واحدة منها يمكن تمريرها من خلال السجلات Dim rst As Recordset Dim strSearchName As String Set rst = Me.RecordsetClone strSearchName = tx1 rst.FindFirst "nomarabe = '" & strSearchName & "'" If rst.NoMatch Then MsgBox "Record not found" Else Me.Bookmark = rst.Bookmark End If rst.Close يمكنك ايضا جعل الكود في حدث بعد التحديث لمربع التحرير .. وتحذف ازرار الفلترة BASEL4.rar

السلام عليكم مرفق لحاضرتكم ملق اكسيل مكون عدد من اوراق العمل اريد كود vba لمعرفه اعداد الذكور و اعداد الاناث و اعداد الغير محدد طبقا للرقم القومي حيث يعتمد علي الشيت الاساسي Sheet_Main العمود I في الجدول الاول و هو النوع تم استخراجه بواسطه معادله بناء علي الرقم القومي و العمود S يحتوي علي نوع العميل للعملاء للمصروفه مع العلم ان لو العميل اجنبي فبالتالي لم استطع الحصول علي نوعه ذكر ام انثي و كذلك لم استطع الحصول علي سنه لذا تم كتابتها غير محدد علما بان اسماء العملاء ليست فريده اي انها ممكن ان يكون فيها تكرارات اريد كود VBA لحساب عدد الذكور عدد الاناث عدد الغير محدد و اجمالي المبالغ لكل فئه و عدد العمليات التي نفذها كل فئه شكرا جزيلا للمساعد و مرفق عينه بسيطه من العملاء كلمة المرور vbaproject:0404701219 النسخه النهائيه+++++++++++.xlsm

تحية طيبة أستاذنا @Foksh ما شاء الله عليك - معك حق نعم نفس السؤال ونفس الطرح هذه الأكواد أستعملها في حالة النماذج المستمرة في حالة الحفظ إو إلغاء الحفظ (وهو تقريبا) يقوم بنفس عمل excel واستعمله مثلا في حالة حجز علامات الطلاب وتقييم الموظفين.... وقد حصلت عليه بناء على طلب سابق لي هنا . من استاذنا @Moosak وفيه تعديل بسيط لأستاذنا @ابوخليل -بناءا على طلبي - بما أنني وظفت هذا الكود كثيرا - أريد أن أقوم بعملية التعديل على كود البحث فقط- دون المساس بباقي الأكواد - إن أمكن طبعا- حتى لايتأثر المبدأ العام.

تم طرح نفس المشكلة تقريباً في موضوع قديم هنا :- وللأسف كانت فكرتك مبنية على أنك لا تريد أن يتم الغاء التنشيط أو الرول باك .. صحيح !!

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

والله انا كنت عامل استعلامين ( ذكور - إناث ) وتقريرين ( ذكور واناث ) واختار الفصل الدراسي والفئة والصف من النموذج وعامل زر للذكور وزر للإناث ويجلب الدور الأول والدور الثاني بس المشكلة في تكرار الصفوف عندي كما ذكرتك عااليا