Moosak

تفضل عمي @Foksh 🙂 :
Replace(Replace(Format(Time, "hh:mm:ssAM/PM"), "PM", ""), "AM", "") والنتيجة :

حياك الله أستاذ @jo_2010 🙂 
بأمانة قرأت ردك والسؤال الأول أكثر من مرة ولم أفهم المراد بالضبط ، لعل الصيام مأثر علي 😅🖐🏻
ولكن قمت بعمل تعديل على قدر فهمي لطلبك 😊
وهذا شكل الكود بعد التعديل :

عند الضغط على إنتر وهناك عدة تحاليل ينتقل للتحليل التالي حتى يصل للسجل الجديد .. 
وعند المواصلة على الضغط على الإنتر 3 مرات عندها ينتقل لسجل جديد في النموذج الرئيسي ..
إذا كان عدد التحاليل صفر حتى لو تم الاستمرار على مفتاح الإنتر أكثر من 3 مرات يضل المؤشر في مكانه ولا ينتقل.
JO-2024.accdb

وعليكم السلام ورحمة الله وبركاته 🙂 
تفضل أخي @العبيدي رعد
لا تظهر بيانات إلا من كان في ذمته شيء ..

الكود يكتب في الحدث فورمات للمجموعة أو التقسيمة :

الكود : 

القروض 10.rar

يمكنك استخدام هذه الصفحة أيضا للبحث عن المواضيع من خلال عناوينها أو اسم الكاتب :
https://officena.net/team/mas/access.html
🙂 

السلام عليكم 🙂 
الكود صحيح .. المشكلة فقط هي أن النموذج الثاني يجب أن يكون مفتوح ليعمل الكود ..
هنا أضفت لك سطر للتحقق من أن النموذج الثاني مفتوح قبل تطبيق الكود .. ولو كان مغلق يفتحه
' للتحقق من أن النموذج الثاني مفتوح قبل تطبيق الكود If CurrentProject.AllForms("frm2").IsLoaded = False Then DoCmd.OpenForm "frm2" If Me.on = True Then Forms!frm2.btn.Visible = True Else Forms!frm2.btn.Visible = False End If  

الرابط الموجود في الفورم لم يتم إعداده للمشاركة ( يطلب إذن لتحميله ) ، يجب عليك إتاحة المشاركة للتمكن من التحميل ..
 
هذا هو كود التحميل من الجوجل درايف :
كود للتحميل المباشر من الجوجل درايف Google drive
شرح الكود:
لتحميل الملفات من جوجل درايف بنفس الاسم والامتداد
فقط تحتاج رابط الملف كاملا وأن يكون الملف عاما (مشاركا مع الجميع)
الكود يعالج مشكلة أسماء الملفات العربية
صالح للنواتين 32بت وكذلك 64بت
يعمل في كل التطبيقات التي تستعمل vba
يوضع هذا الكود في موديول جديد
الكود:
Sub DownloadFromGD(GDriveURL As String) Dim myURL As String Dim FileID As String Dim xmlhttp As Object Dim name0 As Variant Dim oStream As Object FileID = Split(Split(GDriveURL, "/d/")(1), "/")(0) myURL = "http://drive.google.com/u/0/uc?id=" & FileID & "&export=download" Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP") xmlhttp.Open "GET", myURL, False xmlhttp.Send name0 = DECODEURL(xmlhttp.getResponseHeader("Content-Disposition")) If name0 = "" Then     MsgBox "الملف غير موجود في الموقع"     Exit Sub End If name0 = Split(name0, "*=UTF-8''")(1) 'split after *=UTF-8'' to get utf8 names If xmlhttp.Status = 200 Then     Set oStream = CreateObject("ADODB.Stream")     oStream.Open     oStream.Type = 1     oStream.Write xmlhttp.responseBody     oStream.SaveToFile CurrentProject.Path & "\" & name0, 2 ' 1 = no overwrite, 2 = overwrite     oStream.Close End If Set xmlhttp = Nothing Set oStream = Nothing MsgBox "تم تحميل الملف في نفس مسار البرنامج باسم: " & vbNewLine & vbNewLine & name0 End Sub Function DECODEURL(varText As Variant) Static objHtmlfile As Object If objHtmlfile Is Nothing Then     Set objHtmlfile = CreateObject("htmlfile")     objHtmlfile.parentWindow.execScript "function decode(s) {return decodeURIComponent(s)}", "jscript" End If DECODEURL = objHtmlfile.parentWindow.decode(varText) End Function طريقة الاستدعاء (الاستخدام):
طريقة استخدام الكود مثل السطر المكتوب في الإجراء test أو يمكن وضعه عند الضغط على زر مثلا
ويتكون هذا السطر من كتابة اسم الاجراء DpwnloadFromGD ثم رابط الملف المراد تحميله بين علامتي تنصيص
Sub test() DownloadFromGD "https://drive.google.com/file/d/18jrvTxgR1QTzwm8YaJHIvsdOmqj02L2x/view" End Sub  

وعليكم السلام ورحمة الله وبركاته 🙂 
هذا الكود لعمل تحديد الكل : 
Private Sub btnSelectAll_Click() Dim strSQL As String ' SQL statement to update the "select" field to True strSQL = "UPDATE YourTableName SET [select] = True" ' Execute the SQL statement CurrentDb.Execute strSQL ' Refresh the form to reflect the changes Me.Requery End Sub وهذا لعمل إلغاء تحديد الكل :
Private Sub btnDeselectAll_Click() Dim strSQL As String ' SQL statement to update the "select" field to False strSQL = "UPDATE YourTableName SET [select] = False" ' Execute the SQL statement CurrentDb.Execute strSQL ' Refresh the form to reflect the changes Me.Requery End Sub استبدل "YourTableName"  باسم الجدول لديك
واستبدل "select" باسم حقل الاختيار
 
تفضل أخي العزيز 🙂 
الكود الخاص بعمل زر واحد لـ [تحديد / إلغاء تحديد للكل] السجلات في النموذج المستمر :
Private Sub btn_Select_Deselect_All_Click() '(الكود الذي يتم وضعه على زر (تحديد،إلغاء تحديد الكل Dim CountSelected As Long Dim TableName As String Dim SelectField As String '====================================== 'ضع هنا اسم الجدول TableName = "YourTableName" 'ضع هنا اسم حقل التحديد SelectField = "select" '====================================== 'فحص عدد السجلات المختارة CountSelected = DCount(SelectField, TableName) If CountSelected = 0 Then 'لم يتم تحديد أي سجل نشغل استعلام تحديد الكل CurrentDb.Execute "UPDATE " & TableName & " SET [" & SelectField & "] = True" Else ' هناك سجلات محددة لذلك نشغل استعلام إلغاء تحديد الكل CurrentDb.Execute "UPDATE " & TableName & " SET [" & SelectField & "] = False" End If ' تحديث البيانات في النموذج Me.Requery End Sub لا تنس كتابة اسم الجدول مكان :  "YourTableName"
واسم حقل التحديد :  "select"

هذه فكرتي 🙂 ..

Database.rar

تفضل أخي @Abdelaziz Osman 🙂 
جعلته حقل محسوب غير مرتبط بالجدول وذلك لكي يعدل الترقيم نفسه حتى لو تم حذف السجلات ..
وهذه قيمة الحقل :
=IIf(IsNull([معرف]);"";DCount("*";"[Talabat]";"[معرف]<=" & [معرف]))  
ترتيب الترقيم.accdb

تفضل مرفقك أخي @Hamtoooo بعد تطبيق تعليمات معلمنا العود @ابوخليل 🙂 
 
نفس الرسائل والأزرار .. وألق نظرة على محتويات الوحدة النمطية  وكذلك جرب تغيير النصوص فيها ولاحظ الفرق في النموذج ..
وهذا محتوى الوحدة النمطية :
Option Compare Database Option Explicit Public Function Default_MSGBOX() 'الرسالة الموحدة MsgBox "هذه الرسالة موحدة", , Default_Title End Function Public Function Default_Title() As String ' العنوان الموحد Default_Title = "( اوفيسنا | الاصدار 3.8 )" End Function Public Function Default_Text() As String ' نص ثابت يكتب في الوحدة النمطية Default_Text = "هذا النص تم استدعائه من الوحدة نمطية" End Function Public Function DeleteBtn_Click() 'أمر عام يوضع على أزرار الحذف لحذف السجلات On Error GoTo Err_DeleteBtn_Click DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Exit_DeleteBtn_Click: Exit Function Err_DeleteBtn_Click: MsgBox Err.Description Resume Exit_DeleteBtn_Click End Function  
استدعاء الاكواد.accdb

تفضل 🙂 

DLookUp("[المسافة]";"[Table1]";"[city1] ='"& [Forms]![Form1]![city1] &"' And [city2] ='"& [Forms]![Form1]![city2] &"' ")  
test.rar

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

ويمكنك إخفاء المربع الذي في اليسار (Image Source) عند الانتهاء ..
لاحظ يجب أن يكون ملف الصور بجانب البرنامج وعدم تغيير موقعه حتى لايتم فقد الرابط بينهما :
                     
Change Image.zip

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


مهام الموظفين.accdb

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

النمط الثاني :

للتحميل :
MoosaK_Pattern_Lock.accdb

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

أو يمكنك استخدام هذه الأكواد البديلة :
3 دوال لـ ( نسخ - لصق - تفريغ الذاكرة )
شرح الكود:
ضع الكود كاملا في موديول ثم استخدمه في البرنامج كما هو واضح في الأسفل ..
الكود:
'==================================================(Copy) Public Function CopyText(ByVal Text As Variant) As Boolean     CopyText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text) End Function '==================================================(Paste) Public Function PasteText() As String     On Error Resume Next     PasteText = CreateObject("htmlfile").ParentWindow.ClipboardData.getData("Text") End Function '==================================================(Clear The ClipBoard) Public Function ClearClipBoardText() As Boolean     ClearClipBoardText = CreateObject("htmlfile").ParentWindow.ClipboardData.clearData("Text") End Function طريقة الاستدعاء (الاستخدام):
CopyText(Text)          <------ للنسخ PasteText()                <------ للصق ClearClipBoardText()     <------ تفريغ الذاكرة

وعليكم السلام ورحمة الله وبركاته 🙂 
هل هذا ما تريده ؟ 

 
طبعا للحصول على هذه البيانات ..
أنسخ الموديول المرفق كاملا كما هو .. 
وهو يحتوي على العديد من الدوال الخاصة بالتعامل مع الملفات من جميع النواحي ( نسخ - لصق- نقل - حذف - ودوال للحصول على بيانات الملفات كما هو واضح لديك .. 🙂 )
ثم في مربعات النص التي في النموذج أنظر لطريقة إحضار بيانات الملفات .. باستخدام الدوال المرفقة في الموديول ..
وكذلك في كل دالة مكتوب فيها بالتفصيل كيفية استخدامها 🙂 
TknDate.accdb

وعليك السلام ورحمة الله وبركاته أخي @Foksh 🙂 
برنامج وتصميم جميل جدا ماشاء الله .. وفقك الله 🌹
الظاهر أنك وضعت فيه خلاصة الخبرات والأفكار تبارك الرحمن 🙂 
أعجبتني طريقة التنصيب وإعدادت البداية ..
ولكن واجهتني عدة أمور قد تواجه الآخرين أيضا 😅
1- برامج الفيروسات تعتبر الملف كفيروس .. لذلك ستضطر لإيقاف برنامج الفيروسات قبل فك الضغط .
2- تقريبا 95% من الأزرار والخدمات لا تعمل في النسخة التجريبية لعدم وجود صلاحيات ... فقط تظهر هذه الرسالة .. :

والأصل أن تكون النسخة التجريبية كاملة الصلاحيات ولكن لفترة محدودة .. أو لعدد محدود من السجلات ( وجهة نظر ) 🙂 .
3- ملف الجداول غير محمي .. يمكن فتحه بسهولة والعبث بمحتوياته .. أغلقة برقم سري ..
4- تحذيرات الاستعلامات الإجرائية تظهر للمستخدمين .. وهي تعتبر مزعجة نوعا ما ..😅🖐🏼️

5- لعبة أكس أو .. ما فيها زر خروج 😁
6- الأصناف لا تظهر في شاشة البحث عن الأصناف... ولا شاشة الاستعلام عن أرصدة الأصناف.
 
مع تمنياتي لك بالتوفيق 🙂 🌹

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

والدالة تتابع جميع هذه العمليات : ( إضافة سجل جديد - التعديل على السجلات - حذف السجلات )

 
الدالة : 
Option Compare Database Option Explicit Public Enum NotificationTypeEnum إضافة_سجل_جديد = 1 تعديل_البيانات = 2 حذف_السجل = 3 End Enum ' [NotfID], [FormName], [Type], [Action], [ByUser], [DateTime], [Done] Public Function AddNotification(strFormName As String, NotificationType As NotificationTypeEnum, _ Action As String) As Boolean 'دالة إضافة بيانات سجل التعديلات على سجلات البرنامج On Error GoTo Error_Handler Dim strSQL As String Dim UserName As String Dim NotfTxtType As String Select Case NotificationType Case Is = 1: NotfTxtType = "إضافة سجل جديد" Case Is = 2: NotfTxtType = "تعديل البيانات" Case Is = 3: NotfTxtType = "حذف السجل" End Select AddNotification = True UserName = Environ("UserName") strSQL = "INSERT INTO EditsLog_T ( [FormName], [Type], [Action], [ByUser]) " & _ " VALUES ('" & strFormName & "' ,'" & NotfTxtType & "' ,'" & Action & "' , '" & UserName & "' );" CurrentDb.Execute strSQL Error_Handler_Exit: On Error Resume Next Exit Function Error_Handler: If Err.Number = 0 Then Resume Next MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: Insert2History" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "Code: AddNotification" AddNotification = False Resume Error_Handler_Exit End Function Sub testNotf() Debug.Print AddNotification("نموذج الحركات", تعديل_البيانات, "تفاصيل التعديل") End Sub الأكواد في النموذج : 
Private Function Add2History() 'دالة إضافة التعديلات لهذا النموذج Dim strChange As String strChange = "في السجل رقم ( " & Me.PreCode & " ) تم التعديل على الحقل( " & Screen.ActiveControl.Name & " ) مـن : " & Screen.ActiveControl.OldValue & vbNewLine & "إلى : " & Screen.ActiveControl.Text 'Debug.Print strChange Call AddNotification(Me.Name, تعديل_البيانات, strChange) End Function Private Sub Form_AfterInsert() AddNotification Me.Name, إضافة_سجل_جديد, "تم إضافة السجل : " & Me.PreCode End Sub Private Sub Form_Delete(Cancel As Integer) AddNotification Me.Name, حذف_السجل, "تم حذف السجل : " & Me.PreCode End Sub ملفك بعد التعديل :
QRSystem1.zip

نعم استخدم هذا الكود في حدث عند التركيز للحقل المطلوب :
If InStr(1, Me.TextBoxName, "Word") > 0 Then Me.TextBoxName.Locked = True Else Me.TextBoxName.Locked = False End If  

شكر لك أخي @عبد اللطيف سلوم 🙂 

كود لعمل ترقيم متسلسل للسجلات في النموذج المستمر أو المفرد في حقل غير منظم
شرح الكود:
يوضع في موديول منفصل ..
ثم في حقل المسلسل في النموذج ويكون حقل غير منظم يكتب في مصدر بياناته هكذ : =RowNum([Form])
الكود: 
Public Function RowNum(frm As Form) As Variant On Error GoTo Err_RowNum     'Purpose:   Numbering the rows on a form.     'Usage:     Text box with ControlSource of:  =RowNum([Form])          With frm.RecordsetClone         .Bookmark = frm.Bookmark         RowNum = .AbsolutePosition + 1     End With      Exit_RowNum:     Exit Function      Err_RowNum:     If Err.Number <> 3021& Then  'Ignore "No bookmark" at new row.         Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description     End If     RowNum = Null     Resume Exit_RowNum End Function
طريقة الاستدعاء (الاستخدام):
=RowNum([Form])  

تفضل أخي @elghoultk 🙂 

OpenFormFromCombo.accdb

للأسف لم أجد موضوع شافي وكافي يشرح الطريقة في المنتدى .. ولكن وجدت لك هذه الفيديوات تشرح لك الطريقة 🙂 :
https://www.youtube.com/watch?v=A5cdjV2a9FQ
https://www.youtube.com/watch?v=2I0aZmZ62Lk
https://www.youtube.com/watch?v=ux7X8C3K_bU
https://www.youtube.com/watch?v=3s9OI-6t8fM
 
 

وعليكم السلام ورحمة الله وبركاته أخي حسين 🙂 
تفضل :
If t = b Then msgbox "القيمة الرقمية الموجود في حقل t تساوي القيمة التي في حقل b " ' "ثم تكتب هنا ما تريد من البنامج فعله لو تحقق الشرط" End If