ناقل

جرب المرفق
 
open.accdb
Private Sub Form_Load() Call CopyText("Pa@ 12345678") End Sub Public Function CopyText(ByVal Text As Variant) As Boolean CopyText = CreateObject("htmlfile").ParentWindow.ClipboardData.SetData("Text", Text) End Function  

جرب كده
Private Sub Form_Current() Dim ctl As Control ' التحقق من قيمة الحقل MAN If Me.MAN = "HTM" Then ' اجعل جميع الحقول غير قابلة للتحرير For Each ctl In Me.Controls If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then ctl.Locked = True End If Next ctl ' السماح بتعديل الحقول الثلاثة فقط Me.INFU.Locked = False Me.MUR.Locked = False Me.POL.Locked = False Else ' إذا لم يتحقق الشرط، اجعل جميع الحقول غير قابلة للتعديل For Each ctl In Me.Controls If ctl.ControlType = acTextBox Or ctl.ControlType = acComboBox Then ctl.Locked = True End If Next ctl End If End Sub  

احسن انه في تناقض في كلامك ..... كيف برنامجك ترقيم غير مكرر وانت تتعمد اضافة سجل برقم مكرر ولا تريد رسالة الخطأ ....!!!!!!!!!! ؟؟؟؟؟
اضف السجل بدون اضافة رقم والبرنامج هو المسؤل عن الترقيم .... ثم يعيد ترتيب الارقام حسب تسلسل التاريخ .......
جرب ملفي بالطريقة التي ذكرتها لك دون ان تسجل او تغير الرقم الظاهر في مربع النص ....

جرب كده .....
 
‏‏جديد - نسخة.accdb

طبق كما في الصورة ................
 

ولماذا لايكون التاريخ تلقائي حسب السنة الدراسية .... دون الحاجة لارتباطها بالنموذج ؟؟؟

استبدل عبارة sql الموجود في الاستعلام بهذا 
UPDATE [2024 misr pharma expenses] INNER JOIN CASH_OUT_ACCOUNT_EXPENSES_DETAILS_MPC ON [2024 misr pharma expenses].auto_number_excel = CASH_OUT_ACCOUNT_EXPENSES_DETAILS_MPC.excel_access_id SET CASH_OUT_ACCOUNT_EXPENSES_DETAILS_MPC.[cash usd out] = [2024 misr pharma expenses].[cash usd out x];  

تفضل ...............................
 


مستندات.accdb

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

طيب ... بارك الله فيك ::::::
انظر الى الجدول tbl_Teachers تم ادراج البيانات المطلوبة مثل الوظيفة
وفي جدول الحضور heures_effectuées_rapport حسب بياناتك اعتمدنا على الاسم  تدوين اسم الموظف والتاريخ ( هل تريد حساب تأخر للموظف مستقبلا ام لا ...... ) لاني تركتها حسب التاريخ فقط
=== وهنا الخلاصة ( في الاستعلام ) تم استخراج اسم الموظف وتاريخ الحضور والوظيفة بدون تسجيلها في جدول الحضور  وبهذا لم نكرر الوظيفة في جدول الحضور 
مرفق المثال :::
 



BASEM (2).accdb

انظر هنا ......
 

جرب المرفق <<<<<
 
Database32.accdb

وهذه طريقة اخرى من الذكاء .....
يجب وضع هذا الكود في النموذج الذي ترغب في تغيير رسالة التكامل المرجعي الخاصة به. عندما يحدث خطأ 3200 الذي يشير إلى رسالة التكامل المرجعي، ستظهر الرسالة الجديدة المحددة في الكود بدلاً من الرسالة الافتراضية. Private Sub Form_Error(DataErr As Integer, Response As Integer) ' رسالة التكامل المرجعي - Reference Integrity Message If DataErr = 3200 Then ' قم بتعديل الرسالة الجديدة هنا MsgBox "رسالة جديدة" Response = acDataErrContinue End If End Sub  
     

Gyab_2.rar

دالة الوقت والتاريخ.rar

وانت في صحة وسلامة 
طيب انشئ وحدة نمطية وضع هذا فيه :::::::
Private Const TIMEOUT = 99 Public Sub Restart() Dim scriptpath As String scriptpath = Application.CurrentProject.FullName & ".dbrestart.bat" If Dir(scriptpath, vbNormal) <> "" Then If DateAdd("s", TIMEOUT * 1, FileDateTime(scriptpath)) < Date Then Kill scriptpath Else Application.Quit acQuitSaveAll Exit Sub End If End If Dim s As String s = s & "SETLOCAL ENABLEDELAYEDEXPANSION" & vbCrLf s = s & "SET /a counter=0" & vbCrLf s = s & ":CHECKLOCKFILE" & vbCrLf s = s & "ping 0.0.0.255 -n 1 -w 100 > nul" & vbCrLf s = s & "SET /a counter+=1" & vbCrLf s = s & "IF ""!counter!""==""" & TIMEOUT & """ GOTO CLEANUP" & vbCrLf s = s & "IF EXIST ""%~f1.%3"" GOTO CHECKLOCKFILE" & vbCrLf s = s & "start "" "" ""%~f1.%2""" & vbCrLf s = s & ":CLEANUP" & vbCrLf s = s & "del %0" Dim intFile As Integer intFile = FreeFile() Open scriptpath For Output As #intFile Print #intFile, s Close #intFile Dim dbname As String, ext As String, lockext As String Dim idx As Integer For idx = Len(CurrentProject.FullName) To 1 Step -1 If Mid(CurrentProject.FullName, idx, 1) = "." Then Exit For Next idx dbname = Left(CurrentProject.FullName, idx - 1) ext = Mid(CurrentProject.FullName, idx + 1) If Left(ext, 2) = "ac" Then lockext = "laccdb" Else lockext = "ldb" End If s = """" & scriptpath & """ """ & dbname & """ " & ext & " " & lockext Shell s, vbHide Application.Quit acQuitSaveAll End Sub  
تحت حدث الزر ضع هذا ::::::::
Utilities.Restart  

تفضل ...
DoCmd.RunCommand acCmdPageSetup  

تفضل ...
DoCmd.RunCommand acCmdPageSetup  

تفضل ...
DoCmd.RunCommand acCmdPageSetup  

جرب هذا في حقل التاريخ .....
Between [Forms]![نموذج_بحث]![from] And [Forms]![نموذج_بحث]![to]  

طيب أهلا عمر .... جرب هل هذا ما تريد ؟؟
On Error GoTo Errw Dim i As Integer DoCmd.GoToRecord , , acFirst For i = 1 To Me.Recordset.RecordCount If Me.Emp_ABSCENT = False Then txtTimeIn.Value = Time Else txtTimeIn.Value = "" End If DoCmd.GoToRecord , , acNext Next i Exit Sub Errw: MsgBox "لقد تم اعتماد الحضور بنجاح بنجاح", vbOKOnly  
حضور وانصراف موظفين.accdb

طيب استخدم هذا الكود ........
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Tablex", m_strFileName, True Dim s As Integer Dim rst As DAO.Recordset Dim rst2 As DAO.Recordset Dim dbs As DAO.Database Dim dbss As DAO.Database Dim tdf1 As TableDef Dim tdf As TableDef Dim fld, fld1 As Field Dim tbl, tbl1 As String tbl = "Table" tbl1 = "Tablex" Set dbs = CurrentDb Set dbss = CurrentDb Set tdf = dbs.TableDefs(tbl) Set tdf1 = dbss.TableDefs(tbl1) Set rst2 = dbs.OpenRecordset(tbl) Set rst = dbss.OpenRecordset(tbl1) rst.MoveLast If rst.Fields.Count <> rst2.Fields.Count Then GoTo dd If IsNull(rst.Fields(1)) Then GoTo dd For Each fld In tdf.Fields s = 0 For Each fld1 In tdf1.Fields If fld.Name = fld1.Name Then s = s + 1 Next fld1 If s = 0 Then GoTo dd Next fld Set dbss = Nothing Set dbs = Nothing rst.Close DoCmd.SetWarnings False DoCmd.OpenQuery "import_tbl" DoCmd.DeleteObject acTable, "Tablex" DoCmd.SetWarnings True txtImportFile = "" MsgBox "Data imported successfully" Exit_أمر8_Click: Exit Sub dd: rst.Close MsgBox "هناك اختلاف في اسماء الحقول " DoCmd.SetWarnings False DoCmd.DeleteObject acTable, "Tablex" DoCmd.SetWarnings True  

تفضل .....
Dim msgstyle Dim DBOld As String Dim DBNew As String DBOld = Me.txtTAB1 'اختيار قاعدة بيانات الجداول DBNew = txtPathToExport 'اختيار مكان حفظ النسخة Shell "cmd.exe /C copy " & """" & DBOld & """" & " " & """" & DBNew & "\" & "DATA.accdb" & """", 0 MsgBox Space(20) & "تمت العملية بنجاح.." & Space(20), msgstyle, "للمعلومية"  

لمعرفة عدد السجلات بالاعتماد على حقل ضع =Count([id]) حيث اسم الحقل id لمعرفة عدد السجلات من غيرالاعتماد على حقل ضع =Count(*) ان لم تجد نتيجة ...... ارفق النموذج الذي به المشكلة

اولا : عليكم السلام
ثانيا : حياك الله في المنتدى
ثالثا : هل تريد طباعة هذه الارقام على تقرير يعني مثلا كنبت في المسج 1-5 ..... تقوم الطابعة بطباعة خمس تقارير مرقمة التقرير 1 ... التقرير2 ... التقرير3 ... التقرير4 ... التقرير5   صحيح

هذه يسهل ما تشاء من شروط ....
استخدم هذا 
Dim myCriteria As String myCriteria = "[نوع المستند] = '" & Me.نوع_المستند & "'" myCriteria = myCriteria & " AND " myCriteria = myCriteria & "[كود الدعوي] =" & Me.كود_الدعوي Me.n = DCount("[كود الحركة]", "harka", myCriteria)