د.كاف يار

طيب اتفضل هذا التعديل حساب عدد الورديات والساعات حسب التاريخ.zip

تفضل ضع هذا الكود في ازرار انشاء نسخة احتياطية On Error GoTo ErrH Dim fso As Object Dim fldrname As String Dim fldrpath As String Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\Backup" If Not fso.FolderExists(fldrpath) Then fso.createfolder (fldrpath) DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);" End If Dim MyFile, DstFile As String Dim Syso As Object MyFile = CurrentProject.FullName DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Now, "dd-mm-yyyy") & "-" & Format(Now, "hh-nn-ss") & ".accdb" DBEngine.Idle Set Syso = CreateObject("Scripting.FileSystemObject") Syso.copyfile MyFile, DstFile Set Syso = Nothing Name DstFile As DstFile & ".ptc" DBEngine.CompactDatabase DstFile & ".ptc", DstFile Kill DstFile & ".ptc" Dim db As DAO.Database Dim MaxBackup_NO As Integer MaxBackup_NO = Nz(DMax("[Backup_NO]", "[Backup]"), 0) + 1 Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("Backup") With rs .AddNew ![Backup_NO] = MaxBackup_NO ![Backup_Name] = Format(Now, "dd-mm-yyyy") & "-" & Format(Now, "hh-nn-ss") ![Backup_Path] = DstFile ![Backup_Date] = Now() .Update End With rs.Close Set rs = Nothing MsgBox "تم انشاء قاعدة البيانات بنجاح" & vbNewLine & "Database successfully created" & vbNewLine & vbNewLine & "" & "اسم قاعدة البيانات" & vbNewLine & "The name of the database" & vbNewLine & "" & vbNewLine & "Backup-" & Format(Date, "dd-mm-yyyy") & vbNewLine & vbNewLine & "" & "مسار القاعدة الجديدة" & vbNewLine & "Path of the new rule" & vbNewLine & "" & vbNewLine & DstFile, vbMsgBoxRight + vbOKOnly, "emphasis" & "/" & "تاكيد" Exit Sub ErrH: Select Case Err.Number End Select

تفضل التعديل حساب عدد الورديات والساعات حسب التاريخ.zip

تفضل هذا الحل بالإمكان تغيير وقت الإنصراف من خلال الكود نهاية الدوام الساعة 8 صباحا و بعدها سيتم حساب يوم جديد Public Function Overtime(RealCheckoutTime As Date, CheckoutTime As Date) Select Case CheckoutTime Case #1:00:00 AM# To #8:00:00 AM# Overtime = DateDiff("h", DateAdd("d", -1, RealCheckoutTime), CheckoutTime) Case Is > RealCheckoutTime Overtime = DateDiff("h", RealCheckoutTime, CheckoutTime) Case lese Overtime = 0 End Select End Function New Microsoft Access Database.accdb

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

تفضل جرب Nz(DSum("[Loan_Payment]", "[tbl_Loans]", "Format([Loan_AwardMonth],'yyyy') Like '*" & Me.txtYear & "*' And [Loan_Type] Like 'Cridi'"), 0)

استخدم هذا

اتوقع كذا صح IIf(DateDiff("h";CDate([بدايه الانصراف]);CDate([الانصراف]))<=0;0;DateDiff("h";CDate([بدايه الانصراف]);CDate([الانصراف]))) حسب هنا فإذا كان فرق الانصراف الاساسي عن الانصراف الفعلي اقل من صفر فتكون النتيجة صفر New Microsoft Access Database.accdb

تفضل استخدم هذه المعادلة بكل بساطة DateDiff("h";CDate([الانصراف]);CDate([بدايه الانصراف])) New Microsoft Access Database22222.zip

نفس الحال اخي الكريم الكود الموجود في المرفق عبارة عن تايمر فقط لا اكثر تستطيع اضافة ما تريده عند انتهاء الوقت لكن لا علاقة له بأساس الموضوع Static OldcontrolName As String Static OldFormName As String Static ExpiredTime As String Dim ActivecontrolName As String Dim ActiveFormName As String Dim ExpiredMinutes As String '<<<<< ابو نادر >>>>> On Error Resume Next ActivecontrolName = Screen.ActiveControl.Name ActiveFormName = Screen.ActiveForm.Name Me.txtActiveForm = ActiveFormName If (OldcontrolName = "") Or (OldFormName = "") _ Or (ActiveFormName <> OldFormName) _ Or (ActivecontrolName <> OldcontrolName) Then OldcontrolName = ActivecontrolName OldFormName = ActiveFormName ExpiredTime = 0 Else ExpiredTime = ExpiredTime + Me.TimerInterval End If 'ExpiredMinutes = (ExpiredTime \ 1000) \ 60 'للدقائق ExpiredMinutes = (ExpiredTime \ 1000) 'للثاوني Me.txtIdelTime = ExpiredMinutes If ExpiredMinutes >= 50 Then 'لتفيير الوقت ExpiredTime = 0 Application.quit acQuitSaveAll ' <<<<<<<<<<<<<<<<<<<<< هذا الأمر يقوم بإنهاء الأكسس بالكامل تستطيع استبداله >>>>>>>>>>>>>>>>>>>>>>>>>> 'Call AllForms 'DoCmd.OpenForm "frm-UserLogon" End If

تفضل هذا التعديل ***** لكن قبل البدء يجب ان يكون اسم المفتاح الاساسي هو "ID" قي كل جدول Sub indexDelet() Public Function ReNumber() Dim db As DAO.Database Dim rs As DAO.Recordset Dim tdf As DAO.TableDef Dim idx As ADOX.Index Dim x As Integer Dim sSQL As String, S As String Set db = CurrentDb For Each tdf In db.TableDefs If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then sSQL = "ALTER TABLE [" & tdf.Name & "] ALTER COLUMN [id] LONG" db.Execute sSQL Set rs = CurrentDb.OpenRecordset(tdf.Name) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) x = x + 1 rs.Edit rs.Fields("id") = x rs.Update rs.MoveNext Wend End If rs.Close Set rs = Nothing End If x = 0 Next MsgBox "تم اعادة الترقيم بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" End Function و في ازرار اعادة الترقيم ضع التالي Call ReNumber

انشئ Module جديد و الصق فيه الشفرة التالية Public Function ReNumber() On Error Resume Next Dim db As DAO.Database Dim rs As DAO.Recordset Dim tdf As DAO.TableDef Dim x As Integer Dim sSQL As String Set db = CurrentDb For Each tdf In db.TableDefs If Not (tdf.Name Like "MSys*" Or tdf.Name Like "~*" Or tdf.Name Like "exl*") Then sSQL = "ALTER TABLE [" & tdf.Name & "] Add [ID_New] Number" db.Execute sSQL Set rs = CurrentDb.OpenRecordset(tdf.Name) If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) x = x + 1 rs.Edit rs.Fields("ID_New") = x rs.Update rs.MoveNext Wend End If rs.Close Set rs = Nothing End If x = 0 Next MsgBox "تم اضافة ترقيم لجميع الجداول بنجاح", vbInformation + vbMsgBoxRight, "تأكيد" End Function و في النموذج ازرار اعادة ترقيم ضع الأمر التالي Call ReNumber

تفضل

جرب هذي المحاولة الجمعية.accdb

انشئ Module جديد و الصق الشفرة التالية فيه Option Explicit Public Function StartTimer(NumberOfSeconds As Variant, ReportName As String) On Error Resume Next Dim PauseTime, Start, Finish, TotalTime PauseTime = NumberOfSeconds Start = Timer Do While Timer < Start + PauseTime DoEvents Loop Finish = Timer TotalTime = Finish - Start DoCmd.Close acReport, ReportName, acSaveYes End Function في ازرار فتح التقرير و بعد أمر فتح التقرير اعطي الأمر لتشغيل التايمر / المؤقت بعد اعطائه عدد الثواني و اسم التقرير StartTimer(«NumberOfSeconds»; «ReportName») مرفق التعديل tbl.accdb

ارفق مثال لكي يتم التعديل عليه

ياليت توصف مهمة هذا الكود عشان نتوصل لحل و تفضل هذه المحاولة تكويد.accdb

ماشاء الله لا قوة الا بالله فنااااان و مبدع

تفضل هذا التعديل odbExe2.zip

تفضل هذا التعديل odbExe.zip

تفضل التعديل New folder (2).zip

تفضل هذا Microsoft Access Database جديد (3).zip

هل اسماء الملفات موجودة في جدول ؟؟

تفضل التعديل ترتيب رقم 3 - نقل طالب واحد - نقل جميع الطلاب في المجموعة رقم 2 listboxSearch (4).zip

الحمد الله العفو و كلنا اخوان و في خدمتك