Moosak

على الرحب والسعة أخي العزيز 🙂

ما يخطر ببالي هو أنا السجل الحالي غير محفوظ بعد ( Not Saved ) . الأفضل أن ترفق مثال (مرفق) ليتضح الأمر .

هات مرفق .. أو صورة للكويري ..

نعم أخي طارق ممكن .. ضع الكود في حدث بعد التحديث للحقل الذي تريده .

حسب ما فهمت .. قمت بعمل زر في النموذج لإضافة السجلات ووضعت له الكود التالي : Private Sub EnterBtn_Click() Dim ID As String Dim N, X As Integer ID = Me.bar N = Me.n_istimara.Value For X = 1 To N DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO istimaraALL ( bar, m, istimaracode ) SELECT '" & ID & "', " & X & " , 'istimaracode Here' ;" DoCmd.SetWarnings True Next X Me.istimarabassemSubform.Requery End Sub ليعطيك النتيجة 🙂 : وللعلم : أنت وضعت istimaracode كشرط أساسي (مطلوب) لإضافة السجلات بالأسفل ، لذلك يحتاج تعدلها في الكود وتضع القيمة التي تريدها في المكان المحدد هنا : DoCmd.RunSQL "INSERT INTO istimaraALL ( bar, m, istimaracode ) SELECT '" & ID & "', " & X & " , 'istimaracode Here' ;" أو أن تلغي خيار أنه حقل "مطلوب" من خيارات الجدول istimaraALL .. وتضيفها بنفسك لاحقا في النموذج . المرفق : 1358524440_.rar

عدلت لك الكود ليقبل أكثر من ملف ويحفظ كل مسار في سجل جديد ..

تم التعديل أخي .. كنت نسيان تضيف فاصلة (,) في الكود قبل الفلتر . 1276627580_-Copy.accdb

وعليكم السلام ورحمة الله وبركاته .. بارك الله فيك أخي سيمو وغفر الله لك ولوالديك ولجميع أحبابك .. الحقيقة إضافة مفيدة جدا وقيمة أيضا ويكثر استخدمها للمبرمجين .. وكإضافة بسيطة لنفس الموضوع في نفس السياق إكتشفتها من وقت قريب أن هذا الخيار يظهر لك عند الضغط على زر الشفت مع الزر الأيمن للماوس على الملف 🙂

ضع هذا الكود في حدث عند وجود شوائب أو On Dirty للنموذج هكذا : Private Sub Form_Dirty(Cancel As Integer) Me.lastupdate = Now End Sub وأفضل أن تستخدم Now بدل Date .. ليعطيك التاريخ والوقت

تفضل هذا هو الكود 🙂 : Sub GetFiles() Dim fdialog As Office.FileDialog Dim filepath As String Dim Item As Variant Set fdialog = Application.FileDialog(msoFileDialogFilePicker) With fdialog .Title = "Select image" .AllowMultiSelect = True .Filters.Clear .Filters.Add "Image file", "*.jpg ; *.bmp ; *.png" If .Show Then For Each Item In .SelectedItems DoCmd.GoToRecord , , acNewRec filepath = .SelectedItems(1) [PthIn1] = filepath Next Else Exit Sub End If End With MsgBox "تم إضافة الملفات بنجاح" End Sub

هل هذا هو الكود الذي تريد التعديل عليه؟

وعليكم السلام ورحمة الله وبركاته .. الكود موجود ولكن نحتاج مرفق للتطبيق عليه .. 🙂

وفقك الله أخي نبيل @nabilalibibo .. ولا تنسى التأشير عليها كأفضل إجابة 👍😉

تم تعديل الكود : Public Sub Check(FiledName As Control) Dim X As Integer Dim Count As Integer Dim TL As Integer Dim L, M As String TL = Len(FiledName) For X = 1 To TL L = Mid(FiledName, X, 1) M = Mid(FiledName, X, 2) If IsNumeric(L) = True Then If L > 5 Then Count = Count + 1 End If End If If IsNumeric(M) = True Then If M > 5 Then Count = Count + 1 End If End If Next X If Count > 0 Then FiledName.FontBold = True FiledName.ForeColor = vbRed Else FiledName.FontBold = False FiledName.ForeColor = vbBlack End If End Sub والآن تتعرف عليها بفضل الله .. المرفق : الرقم 5.accdb

وعند جهينة الخبر اليقين 😅

هذه مشاركتي 🙂 Private Sub Months_AfterUpdate() If Me.Months = "6 شهور" Then Me.End = DateAdd("M", 6, Me.Start) End If If Me.Months = "سنة" Then Me.End = DateAdd("M", 12, Me.Start) End If End Sub DateAdd.accdb

هذا الحل الذي أعددته في حال أن الأخ @elghoultk قال أن حقل النص بهذه الطريقة ( 15 - 20) .. ولكن قد سبقني بها عكاشة @kanory 😅 الحل أن تضع هذه الدالة في محرر الأكواد : Public Sub Check(FiledName As Control) Dim X As Integer Dim Count As Integer Dim TL As Integer Dim L As String TL = Len(FiledName) For X = 1 To TL L = Mid(FiledName, X, 1) If IsNumeric(L) = True Then If L > 5 Then Count = Count + 1 End If End If Next X If Count > 0 Then FiledName.FontBold = True FiledName.ForeColor = vbRed Else FiledName.FontBold = False FiledName.ForeColor = vbBlack End If End Sub ثم تناديها عند حدث بعد التغيير لمربع النص + وكذلك عند حدث في الحالي للنموذج .. هكذا : ( ولا تنسى تغيير اسم مربع النص ) 🙂 Private Sub Form_Current() If IsNull(Me.NumberxTxt) Then Exit Sub Check NumberxTxt End Sub Private Sub NumberxTxt_AfterUpdate() Check NumberxTxt End Sub والنتيجة عند عدم وجود رقم أكبر من الخمسة : وعند تحقق المطلوب : مرفق المثال : الرقم 5.accdb

اعمل تنسيق شرطي للخلية أخي العزيز .. بحيث لوكان قيمة مربع النص >5 يكون الخط سميك .. هذا حسب ما فهمته على فرض أن محتوى الخلية كله أرقام ، إلا إن كان قصدك أن محتوى الخلية يكون عبارة عن نص هكذا = ( 15 - 20) ؟ فالحل سيكون مختلف . للتكرم بالتوضيح .

تفضل أخي أحمد أحمد أحمد 🙂 ضع هذا الكود في موديول : Public Sub TakeBackup() On Error GoTo MyErr Dim OldFile, NewFile, CopyMyDB, wheretoBackup, BackupFolder, DBName As String OldFile = CurrentProject.FullName BackupFolder = SelectFolder DBName = Left(CurrentProject.Name, InStrRev(CurrentProject.Name, ".") - 1) NewFile = BackupFolder & "\" & DBName & "-Backup-" & Format(Date, "dd-mm-yyyy") & "-" & Format(Now(), "Hh-Nn-ss-AMPM.") & Right(OldFile, 5) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 MsgBox "Backup........Done" & vbNewLine & vbNewLine & "Saved in :" & vbNewLine & NewFile, , " " MyErr: If Err.Number <> 0 Then MsgBox Err.Number & " - " & Err.Description End If End Sub Public Function SelectFolder() On Error GoTo ErrorHandler Dim FileDialog As Object Dim sPath As String Dim sFile As String Set FileDialog = Access.Application.FileDialog(4) With FileDialog .AllowMultiSelect = False .Filters.Clear .Show .Title = "Please select folder" SelectFolder = .SelectedItems(1) End With ExitHandler: Exit Function ErrorHandler: Select Case Err.Number Case Is = 5 MsgBox ChrW("1604") & ChrW("1602") & ChrW("1583") & ChrW("32") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1594") & ChrW("1575") & ChrW("1569") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1605") & ChrW("1585") & ChrW("32") & ChrW("46") & ChrW("46") & ChrW("46") & ChrW("32") & ChrW("40") & ChrW("32") & ChrW("1604") & ChrW("1605") & ChrW("32") & ChrW("1578") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1576") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1610") & ChrW("1583") & ChrW("32") & ChrW("1571") & ChrW("1609") & ChrW("32") & ChrW("1605") & ChrW("1587") & ChrW("1575") & ChrW("1585") & ChrW("41") _ , vbMsgBoxRight + vbMsgBoxRtlReading, _ ChrW("1578") & ChrW("1606") & ChrW("1576") & ChrW("1610") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("40") & ChrW("32") & ChrW("65") & ChrW("116") & ChrW("116") & ChrW("101") & ChrW("110") & ChrW("116") & ChrW("105") & ChrW("111") & ChrW("110") & ChrW("32") & ChrW("41") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1600") & ChrW("1607") Case Else MsgBox "Error Number : " & Err.Number & vbNewLine & "Error Description : " & Err.Description Resume ExitHandler End Select End Function ثم قم باستدعائه هكذا : Call TakeBackup()

ببساطة يا عزيزنا @elghoultk .. تنسخ الدالة ( لكل ليبل الدالة الخاصة به ) .. وتغير اسم الدالة والبيانات اللي فيها حسب المطلوب .. وتحط نداء كل دالة في حدث عند التغيير للعناصر الثلاثة وفي الحالي للنموذج .. أو للخطوة الأخيرة تعمل دالة ثانية أو روتين عام تحط فيها النداءات كلها وبعدين تنادي الروتين مرة وحدة في حدث عند التغيير . إن شاء الله يكون واضح 😁 وبالمثال يتضح المقال 🙂

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

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