كل الانشطه

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

غير محذوفة .. هي فعالة .. ولكنها لا تظهر في الاستعلام الاستعلام يعرض فقط هذا اذا انا فاهم استفسارك السؤال ؟ ما الفائدة من عرض صورة المفاتيح ؟

لا ليس المقصود أنا عايز اعرف ازاي حذفت المفاتيح من qry_Temp في التقرير بتاع المنقولين للصف الأول الإعدادي في الملف السابق

قصدك تعمل جدول ؟ وتعمل له المفاتيح؟ اذا صحيح ؟ لما يكون الجدول مفتوح على التصميم : اضغط على مفتاح Ctrl واستمر ضاغط ثم قم بتحديد الحقول التي تريد اشراكها في المفتاح ثم بزر الفأرة الأيمن حدد المفتاح ... ستجد ان جميع الحقول التي تم تحديدها اشتركت في المفتاح

تمام لحضرتك أخي الفاضل بس عايز أعرف اتعملت ازاي علشان أطبقها

في الرابط التالي ، سلسلة من دروس الأستاذ محمود عبدالغفار ، متأكد أنها ستقدم لك الإجابات الشافية بشكل مرئي .. https://www.youtube.com/hashtag/mahmoudtrainingmicrosoftvba_dao والدرس الأول أعتقد جواب لسؤالك

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

حلوة منك 😄 المفاتيح في الجدول وجدت لضبط وتنظيم الادخالات بينما الاستعلام يعرض فقط

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

وعليكم السلام ورحمة الله وبركاته .. حياكم الله أخي أسعد ، الأداة منفصلة بذاتها للآن .. تستطيع استدعائها وفتحها من خلال زر مثلاً بأحد الخيارين التاليين :- On Error GoTo ErrorHandler Dim dbPath As String dbPath = CurrentProject.Path & "\PDF Converter - 64.accde" Application.FollowHyperlink dbPath Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء محاولة فتح قاعدة البيانات" & vbCrLf & Err.Description, _ vbExclamation + vbMsgBoxRight, "خطأ" أو استخدام الكود التالي :- On Error GoTo ErrorHandler Dim dbPath As String Dim ws As Object dbPath = CurrentProject.Path & "\PDF Converter - 64.accde" If Dir(dbPath) = "" Then MsgBox "ملف قاعدة البيانات غير موجود", vbExclamation Exit Sub End If Set ws = CreateObject("WScript.Shell") ws.Run Chr(34) & dbPath & Chr(34) Set ws = Nothing Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء فتح قاعدة البيانات" & Err.Description, vbExclamation + vbMsgBoxRight, "خطأ" Set ws = Nothing مع ضرورة تغيير اسم قاعدة البيانات في الكود ، وحيث أن مسار المشروع سيكون بجانب قاعدة بياناتك . وكلاهما يعملان ولكن الكود الأول قد ينتج عنه رسالة التنبيه هذه على سبيل المثال :- والسبب في بعض الأجهزة ونسخ الأوفيس عدم تعيين موقع قاعدة البيانات كمصدر موثوق ، لذا في الكود الثاني سيتجاوز هذا التحذير فقط لا غير ..

أخي الفاضل شكرا جزيلا علي الأداة الجميلة كيف أضيف الأدارة لمشروعي ؟ آسف كيف أضيف الأداة لمشوعي ؟

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

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

السلام عليكم واسعد الله اوقاتكم بكل خير المشكلة : بعد الانتهاء من عمل قاعدة لعميل يطلب نسخة للتجربة, ارسل له نسخه تجريبية فيقوم بتسجيل البيانات مثلا قام بإدخال 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

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