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

اخي عند تحميل النموذج يتم حجز السجلات المصدر .. وليس كل عملية بحث تتنفذ مثل الفلتر ومثل المعايير في الاستعلام لذا يجب ان تبحث عن طرق اخرى للبحث وهي كثيرة اليك واحدة منها يمكن تمريرها من خلال السجلات 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

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

اعرض الملف ⭐ أداة تحويل ملفات PDF الى صور 2025⭐ أخواني وأساتذتي ومعلمينا ( دون استثناء ) أقدم لكم هدية بسيطة . وهي أداة لتحويل ملفات الـ PDF الى صور ( إستخراج الصفحات الى صور قابلة للإستخدام الحر ) . مميزات الأداة :- الأداة قادرة على التعرف على خصائص ملف الـ PDF الذي تم اختياره مثل ( تاريخ الإنشاء ، عدد الصفحات ، حجم الملف ) . الأداة تعمل بسرعة وكفاءة عالية . الأداة تمت تجربتها على ملف PDF يحتوي 1500 صفحة لفحص سرعة وجودة الصور المستخرجة . الأداة تتيح للمستخدم اختيار مجلد الإستخراج بشكل يدوي ( خاص به ) أو من خلال مجلد ديناميكي يتم انشاؤه بجانب ملف الأداة . الأداة لها إضافات لاحقة ( تحديثات جديدة ) . الأداة لا تقوم بتحويل ملفات الـ PDF إلى ملفات Doc أو Docx . لأن هذه الميزة تتطلب اشتراكات مدفوعة ( رغم علمي بأنه لا يوجد برنامج أو موقع قادر وبشكل صحيح 100% على التعامل مع النصوص العربية داخل ملفات الـ PDF معلومتي قابلة للخطأ والصواب ) . لاحقاً سيتم إضافة ميزة تحويل ودمج الصور التي تم استخراجها الى ملف Doc أو Docx ، بالتعرف الديناميكي على إصدار أوفيس المثبت على الكمبيوتر للمستخدم . صورة توضيحة لعمل الأداة :- تم تسريع الصورة قليلاً لغاية تقليل الحجم بأقصى حد ممكن دون التأثير على جودة الصورة واجهة الأداة :- مرفق ملف PDF تعليمي - للتحربة :- تعلم آكسيس.pdf صاحب الملف Foksh تمت الاضافه 07/25/25 الاقسام قسم الأكسيس  

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

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

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

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

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

السلام عليكم اريد عند ادخال هذا الكود في النموذج الفرعي تظهر لا توجد بيانات اليكم الكود الشه.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

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

السبب هو الرقم السري لا يتم اضافته الى نتيجة الترم الثاني وبكذا لا يمكن التجميع دعنا من هذا .. حيث يمكن علاجه ولكن السؤال لماذا تخصص استعلام للذكور وتقرير يخصهم ؟ هذا يعني انك ستعمل شيءا مماثلا للاناث وهذا عمل المبتدئين الم تفكر باستعلام واحد وتقرير واحد للكل .. والتصفية تتم من خلال النموذج ؟

مشكلتك من الذي تحذر منه كود الفترة شغال 100% مشكلتك في الكود عند تحميل النموذج BASEL2.rar

عليكم السلام هل هذه حزورة ؟؟ كيف تريد التعديل على الكود .. مع عدم التغيير ؟ اذا انت تقصد الابقاء على استخدام Me.Filter في التصفية .. يمكن السؤال يكون على النحو التالي : اريد تصفية البيانات بناء على الاختيار من مربعي التحرير باستخدام Me.Filter

الأخوة الكرام أسعد الله مساءكم ووفقكم لك خير تحديث جديد يتضمن بعض التعديلات علي نموذج الـ html وهي 1- تم إضافة ميزة البحث بقيم متعدده يفصل بينهم | أو ; أو , وهذا في البحث العام او الحث الخاص بكل نموذج (2) 3- ميزة نسخ كامل محتوي العمود مع أمكانية أختيار الفاصل بينهم او كتابة فاصل جديد (4) وأيضاً اختيار ضم عنوان العمود أم لا (5) 6- تم معالجة بعض القيم لعرض أفضل 7- تم تحسين طريقة نسخ محتوي الخلية للتناسب مع الخلية التي تحمل رابط بداخلها صوره لبعض النتائج بالتوفيق Ahmos_AutoHtmlTable_V1.1_Files.zip

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

أخي الكريم خالد هلال إليك الملف التالي عله يفي بالغرض Sub Tarhil() Dim WS As Worksheet, SH As Worksheet Dim LR As Long Set WS = Sheets("الإيصال"): Set SH = Sheets("اليومية") LR = SH.Cells(Rows.Count, 6).End(xlUp).Row + 1 Application.ScreenUpdating = False With SH .Range("A" & LR) = LR - 4 .Range("B" & LR) = WS.Range("G3") .Range("C" & LR) = WS.Range("G2") .Range("D" & LR) = WS.Range("B4") .Range("E" & LR) = WS.Range("B5") .Range("F" & LR) = (WS.Range("B6") - Int(WS.Range("B6"))) * 100 .Range("G" & LR) = Int(WS.Range("B6")) .Range("H" & LR) = WS.Range("D5") .Range("I" & LR) = WS.Range("B7") WS.Range("G3") = WS.Range("G3") + 1 End With MsgBox "تم الترحيل بنجاح", vbInformation Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي كما لا تنسى أن تضغط أعجبني هذا إذا أعجبتك المشاركة وأدت الغرض تقبل تحياتي Tarhil YasserKhalil.rar

السلام عليكم تفضل أخى هذا الكود يقوم بعمل اللازم Sub ragab() Dim LR As Integer, R As Integer Dim Rng As Range, cl As Range '============================================== Set ws = Sheets("ورقة2") Set WF = Application.WorksheetFunction '============================================== LR = ws.Cells(Rows.Count, 2).End(xlUp).Row Set Rng = ws.Range("B2:B" & LR) Application.ScreenUpdating = False '============================================== Range("B2:M2").Copy If WF.CountIf(Rng, [B2]) > 0 Then ansr = MsgBox("هذا المشروع موجود بالفعل" & Chr(10) & " " & "اذا كنت تريد إستبدالة اضغط نعم" _ & Chr(10) & " " & "وان لم ترد استبداله اضغط لا", vbYesNo, "مشروع مكرر") If ansr = vbYes Then R = WF.Match([B2], Rng, 0) + 1 ws.Range("B" & R).PasteSpecial xlPasteValues GoTo 1 Else GoTo 2 End If End If 2: ws.Range("b" & LR + 1).PasteSpecial xlPasteValues LR = ws.Cells(Rows.Count, 2).End(xlUp).Row For Each cl In ws.Range("A2:A" & LR) cl = cl.Row - 1 Next 1: Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

السلام عليكم في المرفق الكود التالي: Sub ترحيل() Dim L As Integer, R As Integer, C As Integer, CC As Integer, RR As Integer L = Range("A" & Rows.Count).End(xlUp).Row With ورقة2 For R = 2 To L For C = 1 To 17 If Cells(R, 3).Value = .Cells(1, C).Value Then CC = .Cells(1, C).Column For RR = 3 To 33 If Cells(R, 2).Value = .Cells(RR, CC).Value Then .Cells(RR, CC + 1) = Cells(R, 4) .Cells(RR, CC + 2) = Cells(R, 5) End If Next RR End If Next C Next R End With MsgBox "تم الترحيل بنجاح", vbMsgBoxRtlReading + vbMsgBoxRight, "الحمدلله" End Sub Book1.rar

السلام عليكم تفضل المرفق ان شاء الله يكون طلبك ________________.rar