د.كاف يار

تفضل هذا التعديل تم ارجاع كل شي كما في السابق - اضافة العمود الجديد لا يؤثر على البرنامج بشكل عام فهو تنظيمي - محفوظ : تعني انك تستطيع التعديل على السجل في اي وقت . - مرحلة : تعني لا تستطيع التعديل لكن بالإمكان انشاء نسخة ممثالة . مرفق التعديل DATA2000.mdb

تفضل هذا التعديل تم اضافة عمود جديد في الجدول لعملية ترحيل البيانات DATA2000.mdb

تفضل التعديل اخي الكريم DATA2000.mdb

في المعيار ضع التالي [Forms]![paymentcuss]![CustomersID]

تفضل هذا التعديل اظهار جميع الاصناف سواء يوجد عليها حركة او لا ادارة المخازن.rar

العلاقات تتم داخل الاستعلام اذا في الاكسس او في الداتا سيت اذا في لغة اخرى

تفضل استعلام بإسم Q1 ادارة المخازن.rar

انسخ و الصف الكود في حدث لأي ازرار مرفق التعديل On Error Resume Next DoCmd.SetWarnings False DoCmd.RunSQL "SELECT sheet.dept_code, sheet.dept_name, " _ & " Val(Nz(DCount('*','sheet',' dept_code= ' & [dept_code] & ' and c_moslem = 1'),0)) AS مسلم, " _ & " Val(Nz(DCount('*','sheet',' dept_code= ' & [dept_code] & ' and c_moslem = 2'),0)) AS مسيحي, " _ & " Val(Nz(DCount('*','sheet',' dept_code= ' & [dept_code] & ' and c_male = 1'),0)) AS ذكر, " _ & " Val(Nz(DCount('*','sheet',' dept_code= ' & [dept_code] & ' and c_male = 2'),0)) AS انثى, " _ & " Val(Nz(DCount('*','sheet',' dept_code= ' & [dept_code] & ' '),0)) AS جملة " _ & " INTO sheet1 FROM sheet GROUP BY sheet.dept_code, sheet.dept_name;" DoCmd.SetWarnings True MsgBox "تم جمع البيانات بنجاح" & vbNewLine & "New Table Name" & " : " & " sheet1 ", vbInformation + vbMsgBoxRight, "تأكيد" sheet_hani.mdb

أخي الكريم جرب استبدل كامل الكود بالسطر التالي DoCmd.OutputTo acOutputReport, reportName, "PDFFormat(*.pdf)", CurrentProject.Path & "\Mail\Report - " & Lst1.Column(1) & " - " & Lst2.Column(4) & ".pdf", False, "", , acExportQualityPrint

جرب هذا التعديل Private Sub Form_BeforeUpdate(Cancel As Integer) On Error GoTo errorhandle If DCount("*", "TBaction", "idexperience=" & Me.idexperience & "and namemetal='" & Me.namemetal & "'") > 0 Then Dim stry As String stry = Me.namemetal Me.Undo Dim rs As Object Set rs = Me.Recordset.Clone rs.FindFirst "[namemetal] = '" & stry & "'" If Not rs.EOF Then Me.Bookmark = rs.Bookmark Me.unit2 = Me.unit2 + 0.6 Set rst = Nothing End If errorhandleexit: Exit Sub errorhandle: MsgBox Err.Description Resume errorhandleexit End Sub

كان البحث في العمود ID تفضل التعديل DATA14.mdb

تفضل هذا التعديل DATA14.mdb

و كذلك هذا حل أخر مع أخي @essam rabea DATA14.mdb

تفضل بهذه الطريقة اخي الكريم كما موضوع به شرح بالتفصيل الطريقة بالكامل

تفضل هذا التعديل اخي الكريم تم اضافة امر انشاء نسخة احتياطية DATA14.mdb

تفضل هذا الكود لأنشاء نسخة احتياطية اخي الكريم انسخ و الصق فقط - سيتم انشاء مجلد لحفظ النسخة الاحتياطية بجوار قاعدة البيانات - يتم حفظ نسخة من قاعد البيانات بتاريخ اليوم - سيتم انشاء جدول جديد يحتوي على اسم النسخة و تاريخها و موقعها 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) End If Dim MyFile, DstFile As String Dim Syso As Object On Error GoTo ErrH MyFile = CurrentProject.FullName DstFile = CurrentProject.Path & "\Backup\Backup-" & Format(Date, "dd-mm-yyyy") & ".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" DoCmd.RunSQL "CREATE TABLE Backup (Backup_NO INT , Backup_Name VARCHAR (50) , Backup_Path VARCHAR (100), Backup_Date Date);" 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(Date, "dd-mm-yyyy") ![Backup_Path] = DstFile ![Backup_Date] = Now() .Update End With 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

تفضل هذا التعديل Da (3).accdb

تفضل هذا التعديل Da (3).accdb

ضع في حدث عن الفتح للتقرير If [Forms]![Table1]![Option6] = -1 Then Me.Image9.Visible = True Else Me.Image9.Visible = False End If

تفضل هذا التعديل اخي الكريم Dim My_Selectdata1 As String Dim My_Selectdata2 As String Dim My_SelectdataWhere As String My_Selectdata1 = "INSERT INTO Table_777_MaturityscheduleOte ( Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink )" My_Selectdata2 = "SELECT Dart, Finncy, [Stop-Salary], CodeStaff, NameStaff, CodeJ, NameJop, CodeSec, NameSection, CodeAdm, NamAdmin, NamCopmany, DateStarWork, NameAsthkak, SalaryPrimry, BadelMove, BadelTravil, BadelOther, PricDay, NoHourse, NoDayStadar, NoDayAchoal, HorsOverTim, ValueOverTim, HorsBack, ValueHorsBack, StopDay, ValueStopDay, GoAfters, ValueQun, GoAprovit, ValueAprovit, SalaryCut, Akopat, ValueAkopat, Kadwoo, ValueKadwoo, TotalS, TotalCut, TotalFree, Descrption, AccountBank, CodeBancks, NamesBancks, AccountBankCombany, Tawgih, Depet, Elpians, PisceLink FROM Table_776_Maturityschedule" My_SelectdataWhere = " WHERE (((Table_776_Maturityschedule.CodeStaff) Between [Forms]![Frm_776_Monthlyroutinescreen]![TextCodeEmp] And [Forms]![Frm_776_Monthlyroutinescreen]![ToextCodeEmp]));" If Me.TextCodeEmp = "" Or Me.TextCodeEmp = " " Or Me.TextCodeEmp = Null Or Me.TextCodeEmp = 0 Then MsgBox "يجب ادخال كود الموظف للاستمرار", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub Else If MsgBox("هل تريد ترحيل الملف المحدد الى جدول الاستحقاق ؟" & _ vbNewLine & " كود الموظف" & " من " & " : " & Me.TextCodeEmp & " - " & " الى " & " : " & Me.ToextCodeEmp, vbYesNo + vbMsgBoxRight + vbExclamation) = vbYes Then DoCmd.SetWarnings False DoCmd.RunSQL My_Selectdata1 & My_Selectdata2 & My_SelectdataWhere DoCmd.RunSQL "DELETE FROM Table_776_Maturityschedule" & My_SelectdataWhere DoCmd.SetWarnings True MsgBox "تم عمل الروتين الشهري وتم اغلاق الروتين", vbInformation + vbMsgBoxRight, "نقل بيانات الرواتب" DoCmd.Close End If End If الترحيل.rar

تفضل طلبك اخي الكريم المخالفات المرورية - Copy.accdb

صدقت فعلا شفرة غير أمنة تم التعديل و تفادي هذي المشكلة مثال الصلاحيات (1).mdb

تفضل هذا المثال اسم المستخدم : Admin كلمة المرور : 123 مثال الصلاحيات.mdb

تفضل التعديل اخي الكريم Ta2seetStation.accdb

الاذونات اعلاه اذا كان التطبيق على شبكة داخلية لكن اذا اردت ان تنشئ صلاحيات بنفسك فهو افضل لك و يتم وضع الصلاحيات في الحدث عند الفتح صلاحيات الاضافة تمكين المستخدم من الاضافة Me.AllowAdditions = True عدم تمكين المستخدم من الاضافة Me.AllowAdditions = False صلاحيات الحذف تمكين المستخدم من الحذف Me.AllowDeletions = True عدم تمكين المستخدم من الحذف Me.AllowDeletions = False صلاحيات التعديل تمكين المستخدم من التعديل Me.AllowEdits = True عدم تمكين المستخدم من التعديل Me.AllowEdits = False