ناقل

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


مستندات.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)  

تفضل ....
 


إحصاء من القائمة المتعددة.accdb

طيب ..... شغل الاستعلام رقم 1 وسوف تجد المطلوب في الجدول 2
 

Database32.accdb

استبدلها بهذا ......
Dim rs As DAO.Recordset  

With Application.Forms If .Count - 1 = 0 Then DoCmd.Close Else For I = .Count - 1 To 0 Step -1 With .Item(I) If .Name <> "Main_Form" Then MsgBox .Name End If End With Next I End If End With  

هههههه ..... تفضل ....
 
encoder replacement 2.rar

جرب كده 
المستخدم ناقل
باس 123
 
Usrse1.accdb