Moosak

تفضل أخي تم التعديل .. الحل يكمن في أنه عليك ضبط عنوان القائمة المنسدلة في الاستعلام بالعنوان الجديد بعدما أصبح النموذج FORM_G كنموذج فرعي لنموذج التنقل .. وهذا هو العنوان الجديد الذي تم تعديله : [FORMS]![نموذج_التنقل]![z].[Form]![حقل 70] الملف بعد التعديل : Service.accdb

تفضل أخي .. تضع هذه المعادلة في محرر الأكواد : Private Function LableValue() As String If Me.age >= 13 And Me.age <= 150 And Me.Age2 = "YEARS" And Me.gender = "male" Then LableValue = "( 17- 13)" End If If Me.age >= 13 And Me.age <= 150 And Me.Age2 = "YEARS" And Me.gender = "female" Then LableValue = "( 16- 12)" End If If Me.age >= 2 And Me.age <= 12 And Me.Age2 = "YEARS" Then LableValue = "( 15- 11.5)" End If End Function ثم تضع جملة النداء لها بعد تحديث الحقول الثلاثة وكذلك في حدث الحالي لنموذج بهذه الطريقة : Private Sub age_AfterUpdate() Me.Label3.Caption = LableValue End Sub Private Sub Form_Current() Me.Label3.Caption = LableValue End Sub Private Sub gender_AfterUpdate() Me.Label3.Caption = LableValue End Sub Private Sub Text6_AfterUpdate() Me.Label3.Caption = LableValue End Sub وهذا هو المرفق بعد التطبيق : تحديث الليبل.accdb

بعد التعديل اشتغل تمام 👍🏼🙂 بارك الله فيك دكتور

أولا أشكرك أخي العزيز .. جهود طيبة إن شاء الله .. لكن عندي ثلاث ملاحظات .. الأولى : برنامج الواتسأب يقف عند كتابة الرسالة ولا يقوم بعملية الإرسال : ثانيا : مربع البحث لايعمل ثالثا : أنا أعمل على نواة 64 بت فاضررت لإضافة PtrSafe على هذه الجمل : Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal _ hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _ lpApplicationName As Long, ByVal lpCommandLine As String, ByVal _ lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _ ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _ ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, _ lpStartupInfo As STARTUPINFO, lpProcessInformation As _ PROCESS_INFORMATION) As Long Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _ hObject As Long) As Long

وجدت هذا الموضوع في مكتبة الموقع :

...

إمضِ قُدما باش مهندس عمر .. 👍🏻🙂 أحييك على هذه الأفكار ✌🏻️

فكرة رائعة باش مهندس .. بارك الله فيك 🌹😊 فقط لاحظت أن زر الحذف يعمل في حال الحماية .. ربما من الأفضل منع الحذف أيضا 🙂

مثل ما قال الأستاذ ناقل + عمل تنسيق شرطي لتلوين الكومبوبوكس إذا كان فاضي 😁

هذا هو الرابط : https://drive.google.com/file/d/1wfb_sWZGIgooWAApnkGk4emJCSXT9Ho2/view ويمكنك تحميله من هنا لو تعذر الرابط : برنامج الحضور والانصراف.rar

مبارك عليك أخي عمر 🙂🌷🌹

اللهم آمين .. وإياكم

رائع ما شاء الله عليك أخي @Amr Ashraf فكرة جميلة من شأنها أن تبسط تصميم النماذج .. 🙂

تم الإصلاح أخي كناري .. وتأكد دائما أنك تعطي الموديول أسماً مختلف عن اسم الدالة .. وإلا فستحصل على رسالة خطأ .. Database1.rar

يمكنك عملها في استعلام إجماليات هكذا : هناك عدة طرق للحصول على المطلوب .. وتعتمد على الكيفية التي تريد استخدام النتيجة فيها .. XY.accdb

يمكنك فعل ذالك عن طريق هذه الدالة dlookupPlus وهي من عمل أحد الإخوة جزاه الله خيرا .. وقد أخذتها من قناته في اليوتيوب .. وظيفتها هي القيام بإحضار جميع القيم الفرعية الخاصة بسجل رئيسي معين .. وليس فقط القيمة الأولى مثل ما هو الحال عند دالة Dlookup المعتادة . أولا : ضع هذه الدالة في موديول : Function dlookupPlus(Fieldname As String, Domain As String, Optional Criteria = "") Dim db As dao.Database Dim rs As Recordset Dim strsql As String Dim i As Integer Dim st, stt As String On Error GoTo dlookup_err Fieldname = Trim(Fieldname): Domain = Trim(Domain) If IsNull(Criteria) Or Criteria = "" Then strsql = "select " & Fieldname & " from " & Domain Else Criteria = Trim(Criteria) strsql = "select " & Fieldname & " from " & Domain & " where " & Criteria End If Debug.Print "StrSql >> " & strsql Set db = CurrentDb Set rs = db.OpenRecordset(strsql, dbOpenDynaset) rs.MoveLast rs.MoveFirst Debug.Print rs.RecordCount For i = 0 To rs.RecordCount - 1 st = rs(Fieldname).Value & " , " stt = stt & st ' Debug.Print "stt" & stt rs.MoveNext Next dlookupPlus = Left(stt, Len(stt) - 2) dlookup_err: Exit Function End Function ثانيا : استخدمها بنفس طريقة استخدامك لدالة Dlookup العادية ولكن بالمسمى الجديد ( والشرط يكون رقم الفاتورة مثلا ) هكذا : dlookupPlus("Nots","TableName","[FatoorhID]=" & Me.FatoorhID ) طبعا تضع الكود أعلاه كمصدر بيانات مربع النص الذي تريد جمع الملاحظات فيه .

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

تفضل أخي .. قمت بنقل الكود لحدث عند النقر بدل عند التركيز .. ثم قمت بإضافة الشرط والرسالة ليصبح هكذا : Private Sub comm_ex_Click() On Error Resume Next Dim X As Object Dim objWord As Object Set X = CreateObject("Word.Application") Me.Refresh If Me.تدقيق7 = -1 Then 'Continue Else MsgBox "يجب التحديد للقيام بعملية التصدير", vbOKOnly, "تنبيه !" Exit Sub End If X.Documents.Open CurrentProject.Path & "\word_ex.docx" X.Visible = True X.ActiveDocument.Bookmarks("G").Select X.Selection.InsertAfter G End Sub الملف : مثال تصدير إلى ملف وورد 05-07-1443 --15-17.rar

أتوقع أن السر في الماكرو After Update و After Insert و After delet المصاحبة للجداول والله أعلم 😅✋🏻

لك جزيل الشكر معلمنا 🙂 ..

طريقة رائعة جدا وإبداعية في نفس الوقت .. لله دركما 😃🌹

حياك الله وبياك مهندس قاسم .. ما فهمته أنا من خلال الشرح وتحديدا الشق الثاني منه .. أنه يريد تحديد الرقم والتاريخ لحل تحويل لذلك أضفتها .. وإن كان لا يريدهما ويريد تركها فارغة يمكن بتعديل بسيط على الكود تركهما فارغان ولن يسجل أي قيمة عند الترحيل .. ولإلغاء شرط الرقم والتاريخ يكون الكود هكذا : Private Sub TarheelBtn_Click() Dim Count As Integer Count = DCount("*", "[التجهيز]") If MsgBox("هل ترغب في ترحيل " & Count & " سجلات ؟", vbExclamation + vbYesNo, "تحذير !") = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "AttachQ", acViewNormal DoCmd.OpenQuery "DeleteQ", acViewNormal DoCmd.SetWarnings True MsgBox "تم الترحيل بنجاح" Else Exit Sub End If End Sub

جربته على أكثر من نسخة وهو يعمل بشكل جيد .. ولعل الإخوة يفيدوننا إن كان الملف يعمل معهم أم لا ؟

تفضل أخي العزيز .. لديك فورم للترحيل تدخل فيه رقم وتاريخ المستند .. ثم ترحل البيانات .. زر الترحيل يشغل لك استعلامين .. الأول إلحاقي .. والثاني حذف ( يحذف البيانات من الجدول) الكود على زر الترحيل : Private Sub TarheelBtn_Click() Dim Count As Integer If IsNull(Me.DocDatetxt) Or IsNull(Me.DocNumtxt) Then MsgBox "يرجى تعبئة البيانات قبل الترحيل": Me.DocNumtxt.SetFocus: Exit Sub Count = DCount("*", "[التجهيز]") If MsgBox("هل ترغب في ترحيل " & Count & " سجلات ؟", vbExclamation + vbYesNo, "تحذير !") = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "AttachQ", acViewNormal DoCmd.OpenQuery "DeleteQ", acViewNormal DoCmd.SetWarnings True MsgBox "تم الترحيل بنجاح" Else Exit Sub End If End Sub الملف بعد التطبيق : استعلام ترحيل البيانات.accdb

جرب هذا الكود أخي عمر : FollowHyperlink "C:\Users\UserName\Desktop\File.pdf" SendKeys "^p" تضع عنوان رابط الملف بين علامتي التنصيص بعد FollowHyperlink