Moosak

أهلا بك أخي العزيز .. 🙂 ياليت لو تشرح المطلوب ( بالمسميات ) الموجودة في الملف المرفق .. يعني في النموذج ( كذا ) في الحقل ( كذا ) في الجدول ( كذا ) ............

وعليكم السلام 🙂 هل الهدف معرفة الفرق بين التاريخين ؟ >> في هذه الحالة ليس منطقيا أن نحسب الشهور كلها ل 30 يوم !! وإذا كان الهدف أنك تريد معرفة ما هو التاريخ الذي يصادفه لو أضفنا 30 يوم إلى تاريخ البداية مثلا .. فهذا ممكن عن طريق الدالة DateAdd ..

وعليكم السلام 🙂 في لوحة الخصائص ومن Other الخيار Cycle تختار السجل الحالي

أخي figo82eg لا تنسى نقل الموديول basBrowseFiles إلى برنامجك 🙂

وعليك السلام ورحمة الله وبركاته أخي ابو عبد الله العراقي الحل أنك تحول حقل البريد الإلكتروني إلى حقل نصي عادي .. ولتفعيل الرابط التشعبي وضعت لك زر لإرسال بريد إلكتروني مباشرة MustenterValue.rar

أهلا بك أخي figo82eg 🙂 تم عمل المطلوب ،،، وهو على جزئين : 1 - كود لإنشاء المجلدات المطلوبة موضوع على الزر الخاص بالحقل CRN : Public Sub CreatFolders() Dim Fldr1 As String, Fldr2 As String, Fldr3 As String, Fldr4 As String, Fldr5 As String Dim DBPath As String Dim D As String: D = "\" 'فحص ما إذا كانت جميع الخانات معبئة If IsNull(Text10) Or Text10 = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Text10.SetFocus: Exit Sub If IsNull(Me.نوع_الخطاب) Or Me.نوع_الخطاب = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.نوع_الخطاب.SetFocus: Exit Sub If IsNull(Me.Combo1) Or Me.Combo1 = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.Combo1.SetFocus: Exit Sub If IsNull(Me.Combo2) Or Me.Combo2 = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.Combo2.SetFocus: Exit Sub If IsNull(Me.crn) Or Me.crn = "" Then: MsgBox "يرجى تعبئة جميع البيانات": Me.crn.SetFocus: Exit Sub Fldr1 = Me.Text10 Fldr2 = Me.نوع_الخطاب Fldr3 = Me.Combo1 Fldr4 = Me.Combo2 Fldr5 = Me.crn 'إنشاء المجلدات DBPath = BECurrentPath MkDir (DBPath & D & Fldr1) MkDir (DBPath & D & Fldr1 & D & Fldr2) MkDir (DBPath & D & Fldr1 & D & Fldr2 & D & Fldr3) MkDir (DBPath & D & Fldr1 & D & Fldr2 & D & Fldr3 & D & Fldr4) MkDir (DBPath & D & Fldr1 & D & Fldr2 & D & Fldr3 & D & Fldr4 & D & Fldr5) MsgBox "تم إنشاء المجلدات بنجاح" End Sub 2- كود لإحضار الملفات أو الصور على زر مسار الصورة ( ينسخ لك الصورة في المجلد المطلوب ، ثم يعرضها لك) : Private Sub cmdAdd_Click() Dim file As String Dim fileName As String Dim DesPath As String Dim D As String: D = "\" DesPath = (BECurrentPath & D & [Text10] & D & [نوع الخطاب] & D & [Combo1] & D & [Combo2] & D & [crn] & D) If IsFileExists(DesPath) = False Then Call CreatFolders file = selectFile If IsNull(file) Or file = "" Then Exit Sub fileName = GetFileName(file) DesPath = DesPath & fileName FileCopy file, DesPath Me.ImagePath = fileName Me.ImageFrame.Requery MsgBox "تم إضافة الملف بنجاح" End Sub طبعا تم الاستعانة بعدة دوال عامة جميعها موجودة في الموديول basBrowseFiles جرب وأخبرني بالنتيجة 🙂 ارشيف - Moosak.rar

تأكد من الإعدادات الإقليمية عندك في الويندوز واجعلها كلها بالعربي و أختر الدولة التي تعيش فيها ..

حياك الله أخي خليفة 🙂 باستخدام خاصية البحث في المنتدى ستجد العديد من المواضيع التي تتكلم عن نفس الموضوع .. ستستفيد منها إن شاء الله .. https://www.officena.net/ib/search/?q=Translate &quick=1&type=forums_topic&nodes=89&search_and_or=and

شغالة معي تمام .. 👍🏼 فقط أضف هذين السطرين لزر الطباعة : Private Sub أمر43_Click() If IsNull(Me.tx3) Or Me.tx3 = "" Then: MsgBox "يرجى كتابة عدد النسخ": Me.tx3.SetFocus: Exit Sub If IsNull(Me.tx4) Or Me.tx4 = "" Then: MsgBox "يرجى كتابة التاريخ": Me.tx4.SetFocus: Exit Sub DoCmd.OpenReport "Q1", acViewPreview, , , acHidden DoCmd.PrintOut , , , , [tx3] End Sub

وعليكم السلام ورحمة الله وبركاته أخي أبولو .. 🙂 كيف تميز السجل الأول عندك ؟ يحتاج تعمل شرط يستثنيه من بين السجلات .. وممكن تستخدم الجملة التالية كشرط أو معيار لجملة ال SQL أو الاستعلام إن كان لديك حقل ID في الجدول : DCount("*";"[TableName]";"[id]<=" & [id]) <> 1

الله يعافيك أخي العزيز ، وصحة وعافية وهنا يارب 😊

المشكلة في أن المنطق الذي ذكرته أخي @أبو حوده غير دقيق .. والمثال المرفق أيضا غير مناسب للتطبيق على قاعدة واقعية ، فالأسماء مكتوبة كحروف : ر ، ز ، ، س وهذه لا تعطيك نتائج واقعية .. والشيء الآخر ... هب أنك بحثت عن " محمد " ولديك 320 محمد في قاعدة البيانات ومن 320 أسر مختلفة .. أي محمد منهم سيحضر لك ؟ أنت في هذه الحالة تحتاج لفصل البحث عن العرض ، قائمة خاصة بالبحث .. وقائمة أخرى لعرض الإخوة الذين هم في نفس العائلة .. أو أنك تقبل بالبحث بالطريقة التي اقترحتها عليك مع تطويرها بالشكل مناسب . 🙂

شوف هنا : 🙂

تفضل أخي figo82eg 🙂 إضغط على المسار بالنفس للمعاينة PIC-Fixed.rar

اسم التقرير مكتوب خطأ تأكد من كتابته بشكل صحيح 🙂

تفضل أخي أبو حودة 🙂 يتم تصفية الإخوة فقط بعدما تختار أحد نتائج البحث .. تجارب.accdb

وعليكم السلام ورحمة الله وبركاته 🙂 حياك الله أخي العزيز .. نعم حصلت معي كذلك .. والحل موجود في هذا الفيديو وقد انحلت المشكلة معي ولله الحمد ..

تفضل يا أبو حودة 🙂 تجارب.accdb

السلام عليكم ورحمة الله وبركاته .. اليوم جايب لكم موقع وظيفته يقرأ أو يشرح لك الكود بلغة إنجليزية مفهومة ، ويمكنك عن طريق المترجم تحويلها إلى اللغة العربية 🙂 وهذا هو الموقع : https://denigma.app الموقع بفضل الله يتعامل مع معظم اللغات البرمجية تقريبا ، ومن ضمنها الفيجوال بيسك VBA .. وهذا شرح مبسط للاستخدام .. بعد فتح الموقع ننزل تحت إلى هذي الخانة، يوضع الكود في الخانة اليسرى ويظهر التفسير في الجهة اليمنى : نجرب نلصق دالة حساب العمر بالسنة والشهر واليوم ونضغط على [Explain it!] : ولترجمته باللغة العربية ، تأخذ النص لمترجم جوجل فيعطيك النتيجة هكذا : 🙂 هذا وسلامتكم ☺️🌹

وهنا الدالة الأخيرة ( علشان ما أغار ) 😂 حساب العمر.rar

أولا : متأكد أن إجايتك هي أفضل إجابة ؟ 😏 ثانيا هذا شرح مترجم للكود : يبدأ الكود بالتصريح عن المتغيرات التي سيتم استخدامها في البرنامج. تم التصريح عن المتغير db ككائن DAO.Database ، وتم التصريح عن rsP ككائن DAO.Recordset. يفتح الرمز بعد ذلك عبارة SQL لتحديث جميع السجلات في جدول astkbal بقيم 0 لحقول golos1 و lagna ، ولكن فقط إذا لم يتم تعيينها بالفعل على 0 (BOF). إذا لم يتم العثور على سجلات (EOF) ، فإنه يمر عبر كل سجل حتى يعثر على سجل تم فيه تحديث كل من lagna و golos1 إلى الصفر (LOF). ثم ينتقل للعثور على سجل آخر حيث تم تحديث lagna من قيمته الحالية ، والتي تم تعيينها مسبقًا بواسطة rsP! lagna = rsP! lagna؛ تستمر هذه الحلقة حتى تصل إلى x = rsP! frist_golos-rsP! end_golos أو حتى تصل إلى نهاية الملف (EOF) في rsL. بعد تحديث جميع السجلات في قاعدة البيانات ، يتم إغلاقها قبل إغلاق نفسها باستخدام Close (). يستخدم الكود لتحديث جدول الاستقبال من أجل توزيع الطلاب على الفصول الدراسية. يبدأ الكود بفتح مجموعة سجلات لـ tb_Prepare. يتم فحص BOF و EOF قبل متابعة الحلقة. إذا لم يكن هناك خطأ ، فسيستمر مع حلقة while التي ستتكرر خلال جميع السجلات في rsP حتى يتم الوصول إلى rsL. بمجرد الوصول إلى rsL ، سيتم الانتقال إلى السجل التالي وتحريره بحيث يتم تعيين lagna = 0 و golos1 = 0 لكل طالب في صف rsL. بعد تحرير صف كل طالب ، سينتقل إلى تحديث صف كل طالب مرة أخرى بعد تجاوزهم جميعًا.

وهذه دالة أخرى : Function fAgeYMD(StartDate As Date, EndDate As Date) As String 'Purpose: Returns the difference between StartDate and EndDate in full years, months and days 'Coded by: raskew 'To call: ' ? fAgeYMD(#7/6/54#, #10/3/84#) 'Returns: ' 30 years 2 months 28 days Dim inthold As Integer Dim dayHold As Integer inthold = Int(DateDiff("m", StartDate, EndDate)) + _ (EndDate < DateSerial(year(EndDate), month(EndDate), Day(StartDate))) If Day(EndDate) < Day(StartDate) Then dayHold = DateDiff("d", StartDate, DateSerial(year(StartDate), month(StartDate) + 1, 0)) & Day(EndDate) Else dayHold = Day(EndDate) - Day(StartDate) End If fAgeYMD = Int(inthold / 12) & " year" & IIf(Int(inthold / 12) <> 1, "s ", " ") _ & inthold Mod 12 & " month" & IIf(inthold Mod 12 <> 1, "s ", " ") _ & LTrim(str(dayHold)) & " day" & IIf(dayHold <> 1, "s", "") End Function طريقة الاستدعاء : fAgeYMD(StartDate, EndDate)

أخي حسين تفضل قمت بعمل المطلوب 🙂 : ولكن انتبه إلى أن عدد أرقام الجلوس التي وضعتها هي أقل من العدد الفعلي للطلاب ... لذلك بعض الطلاب لم يتم توزيعهم .. وهذا الكود الذي تم استخدامه : Private Sub LejanBtn_Click() On Error GoTo HandleError Dim db As DAO.Database Dim rsP As DAO.Recordset Dim rsL As DAO.Recordset Dim x As Integer CurrentDb.Execute "UPDATE astkbal SET astkbal.golos1 = 0, astkbal.lagna = 0;" Set db = CurrentDb Set rsP = db.OpenRecordset("tb_Prepare") If Not rsP.BOF And Not rsP.EOF Then rsP.MoveFirst While (Not rsP.EOF) Set rsL = db.OpenRecordset("SELECT * FROM astkbal WHERE [saf]= '" & rsP!saf & "' and lagna = 0 And golos1 = 0;") If Not rsL.BOF And Not rsL.EOF Then rsL.MoveFirst For x = rsP!frist_golos To rsP!end_golos rsL.Edit rsL!lagna = rsP!lagna rsL!golos1 = x rsL.Update rsL.MoveNext Next x End If rsP.MoveNext Wend End If rsP.Close rsL.Close Set db = Nothing Set rsP = Nothing Set rsL = Nothing Me.Requery MsgBox "تم توزيع اللجان بنجاح" HandleExit: Exit Sub HandleError: If Err.Number = 0 Then Exit Sub Else MsgBox Err.Number & vbNewLine & vbNewLine & Err.Description End If Resume HandleExit End Sub اعداد الجان_تعديل.rar