محمد أبوعبدالله

وعليكم السلام وحرحمة الله وبركاته جرب التعديل التالي Private Sub DELL_ROW_Click() On Error Resume Next If IsNull(Select3) Then a2.Visible = True MsgBox "يجب تمكين الحذف ", vbCritical + vbMsgBoxRight, "تنبيه" Exit Sub End If If Not IsNull(Select3) Then a2.Visible = False End If DoCmd.SetWarnings False DoCmd.RunCommand acCmdDeleteRecord DoCmd.Requery DoCmd.SetWarnings True End Sub تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم =Round([totol];0) كسر عشري.accdb تحياتي

تفضل يا غالي التجربة 1 - جدول به 3 حقول يحتوي على بيانات ما يقرب من ربع مليون سجل 2 - كود متنوع يقوم باستعلام الحاق بثلاث طرق 3 - النتائج مبهرة '1 CurrentDb.Execute "DELETE * FROM Table3" X = Timer DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO Table3 ( text1, text2, text3 ) SELECT Table1.text1, Table1.text2, Table1.text3 FROM Table1;" DoCmd.SetWarnings True XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time1 " & "==========> " & XTime '2 CurrentDb.Execute "DELETE * FROM Table3" X = Timer CurrentDb.Execute "INSERT INTO Table3 ( text1, text2, text3 ) SELECT Table1.text1, Table1.text2, Table1.text3 FROM Table1;" XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time2 " & "==========> " & XTime '3 CurrentDb.Execute "DELETE * FROM Table3" X = Timer CurrentDb.Execute "Query1" XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time3 " & "==========> " & XTime '4 CurrentDb.Execute "DELETE * FROM Table3" X = Timer Dim db As DAO.Database Dim rs As DAO.Recordset Dim rst As DAO.Recordset Set rs = CurrentDb.OpenRecordset("Table1") Set rst = CurrentDb.OpenRecordset("Table3") For i = 1 To rs.RecordCount rst.AddNew rst.Fields(0) = rs.Fields(0) rst.Fields(1) = rs.Fields(1) rst.Fields(2) = rs.Fields(2) rst.Update rs.MoveNext Next rs.Close Set rs = Nothing rst.Close Set rst = Nothing XTime = Timer - X XTime = Format(XTime, "#0.0####") Debug.Print "Time4 " & "==========> " & XTime Debug.Print "================================" db9.rar تحياتي

وعليكم السلام ورحمة الله وبركاته غير خاصية POP UP الى NO data.rar تحياتي

تقبل الله منا منكم صالح الاعمال وكل عام وانتم الى الله اقرب تحياتي

السلام عليكم جرب الكود التالي Fri_Days = DCount("[HoliDays]", "tblHoliDays", _ "WeekdayName(weekday([HoliDays]),true)= 'Fri'" & _ " and [HoliDays] between#" & Format(begdate, "yyyy/mm/dd") & "#and #" & Format(enddate, "yyyy/mm/dd") & "#") Debug.Print "Fri_Dats:--->" & Fri_Days 'حساب عدد ايام السبت ضمن الاجازة الرسمية بين التاريخين sat_Days = DCount("[HoliDays]", "tblHoliDays", _ "WeekdayName(weekday([HoliDays]),true)= 'Sat'" & _ " and [HoliDays] between#" & Format(begdate, "yyyy/mm/dd") & "#and #" & Format(enddate, "yyyy/mm/dd") & "#") Debug.Print "Fri_Dats:--->" & Fri_Days Project2.accdb تحياتي

نعم يوجد برامج كثيرة علماً انه لا يسمح بتداول مثل هذه البرامج في المنتدى والافضل تحويلها الى accde وبهذه الطريقة لا يمكن عرض الاكواد نهائياً تحياتي

نعم vba محمية بكلمة مرور وهذا موضوع اخر غير الذي نتحدث عنه تحياتي

لا يتم عرض الاكواد اذا كان امتداد الملف accdr اخي الكريم اذا تم اعادة تسمية امتداد الملف accdr فلن يتم تفعيل عمل الشيفت لن يتم عرض جزء التنقل لن يتم عرض عناصر قاعدة البيانات ( جداول - استعلامات - نماذج ... الخ ) لمزيد من المعلومات انظر الرابط التالي https://support.microsoft.com/ar-sa/office/نشر-تطبيق-access-7bb4f2ba-30ee-458c-a673-102dc34bf14f تحياتي

وعليكم السلام ورحمة الله وبركاته تكون قاعدة البيانات الاصلية في اكسيس 2007 وما فوق بصيغة accdb وبعد الانتهاء من البرنامج وقبل تسليمه للعميل يتم تحويل قاعدة البيانات الى accde اما accdr فهو عبارة عن اعادة تسمية امتداد الملف ولا تؤثر على عمله مطلقاً ولكن صيغة accdb و accde يمكن تعطيل الشيفت ورؤية الجداول بعكس accdr فهو يعتبر Runtime لذلك يتم اعادة تسمية امتداد الملف لمزيد من الحماية من عرض عناصر قاعدة البيانات وهذه الطريقة يمكن التغلب عليها ببساطة باعادة التسمية مرة اخرى تحياتي

نعم اخي الكريم الكود الصحيح يكون DSum("[Days]", "tblVacation", "[EmpCode]=" & Me.CbEmpNo) تحياتي

وعليكم السلام ورحمة الله وبركاته وانت بخير وجميع الامة الاسلامية جرب التعديل التالي total = DSum("[Days]", tblVacation, "[EmpCode]="& CbEmpNo) تحياتي

تفضل اخي الكريم db11.accdb تحياتي

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

السلام عليكم جرب التعديل التالي Private Sub رقم_اللوحة_Click() X1 = Nz(DLookup("[الحروف] & '|' & [المصنع] & '|' & [الشاسيه] & '|' & [نوع_المعدة] & '|' & [المالك] & '|' & [المشروع] & '|' & [شركة_التأمين] & '|' & [انتهاء_الاستمارة] & '|' & [المالك]", "المعدات", "[رقم _اللوحة]=" & Me.رقم_اللوحة), "|||||||||") X3 = Split(X1, "|") Me.الحروف = X3(0) Me.المصنع = X3(1) Me.الشاسيه = X3(2) Me.نوع_المعدة = X3(3) Me.المالك = X3(4) Me.المشروع = X3(5) Me.شركة_التأمين = X3(6) Me.انتهاء_الاستمارة = X3(7) Me.المالك = X3(8) End Sub تحياتي

وعليكم السلام ورحمة الله وبركاته ضع الامر التالي في زر امر DoCmd.RunCommand acCmdFind تحياتي

وعليكم السلام ورحمة الله وبركاته ضع معيار في حقل الرقم is not null تحياتي

وعليكم السلام ورحمة الله زبركاته تفضل اخي الكريم هذا الموضوع سيفيدك باذن الله تحياتي

وعليكم السلام ورحمة الله وبركاته استخدم استعلام تحديث بالشكل التالي UPDATE [Table] SET [Table].Country = [ادخل كلمة لتحديث البيانات]; examp.accdb تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم ضع هذه الكود في زر امر On Error Resume Next If IsNull(ToDate) Or IsNull(FromDate) Or IsNull(EndYaer) Then MsgBox "íÌÈ ÇÎÊíÇÑ ÇáÝÊÑÉ æ ÇáÓäÉ ÇáãÇáíÉ ", vbCritical + vbMsgBoxRight, "ÊäÈíå" Exit Sub End If Dim varFilter As Variant varFilter = Null If Not IsNull(Me.Accounts) Then varFilter = (varFilter) & "[Account] LIKE '" & Me.Accounts & "'" End If If Not IsNull(Me.Customers) Then varFilter = (varFilter + " AND ") & "[Customer_ID] LIKE '" & Me.Customers & "'" End If If Not IsNull(Me.ToDate) Then varFilter = (varFilter + " AND ") & "[Registration_Date] Between " & DateFormat(Me.FromDate) & " And " & DateFormat(Me.ToDate) End If If Not IsNull(Me.Registration_document_Number) Then varFilter = (varFilter + " AND ") & "[Registration_document_Number] LIKE '" & Me.Registration_document_Number & "'" End If If Not IsNull(Me.EndYaer) Then varFilter = (varFilter + " AND ") & "[EndYaer] = " & Me.EndYaer End If DoCmd.OpenReport "Report1", acViewPreview, , varFilter الدائن-المدين.zip تحياتي

وعليكم السلام ورحمة الله وبركاته هل تقصد تشفير vba ؟ أم قاعدة البيانات نفسها بحيث تظهر معك هذه الرسالة عند الفتح ؟ اذا كانت الامر كذلك فلن تستطيع تفعيل عمل الشيفت الا بعد الحصول على كلمة السر أولاً ووضعها في الملف الخارجي تحياتي

بالتأكيد اذا كان عدد السجلات كبير سيكون هناك ضريبة للتشفير 🙂 تحياتي

المشكلة في كود التشفير نفسه تفضل اخي الكريم هذا كود لتشفير وفك تشفير البيانات اسرع من المستخدم للتشفير Public Function Encrypt(StringToEncrypt As String, Optional AlphaEncoding As Boolean = False) As String On Error GoTo ErrorHandler Dim Char As String Encrypt = "" For i = 1 To Len(StringToEncrypt) Char = Asc(Mid(StringToEncrypt, i, 1)) Encrypt = Encrypt & Len(Char) & Char Next i If AlphaEncoding Then StringToEncrypt = Encrypt Encrypt = "" For i = 1 To Len(StringToEncrypt) Encrypt = Encrypt & Chr(Mid(StringToEncrypt, i, 1)) Next i End If Exit Function ErrorHandler: Encrypt = "Error" End Function لفك التشفير Public Function Decrypt(StringToDecrypt As String, Optional AlphaDecoding As Boolean = False) As String On Error GoTo ErrorHandler Dim CharCode As String Dim CharPos As Integer Dim Char As String If AlphaDecoding Then Decrypt = StringToDecrypt StringToDecrypt = "" For i = 1 To Len(Decrypt) StringToDecrypt = StringToDecrypt & (Asc(Mid(Decrypt, i, 1))) Next i End If Decrypt = "" Do CharPos = Left(StringToDecrypt, 1) StringToDecrypt = Mid(StringToDecrypt, 2) CharCode = Left(StringToDecrypt, CharPos) StringToDecrypt = Mid(StringToDecrypt, Len(CharCode) + 1) Decrypt = Decrypt & Chr(CharCode) Loop Until StringToDecrypt = "" Exit Function ErrorHandler: Decrypt = "Error" End Function مثال للتفشير DoCmd.RunSQL "UPDATE table12 SET table12.txtbyan = Encrypt([txtbyan])" DoCmd.RunSQL "UPDATE table12 SET table12.txtdes = Encrypt([txtdes])" DoCmd.RunSQL "UPDATE table12 SET table12.txtallkad = Encrypt([txtallkad])" مثال لفك التشفير If Decrypt(DLookup("[pass]", "table12", "[username]='" & names & "'")) = Me.pswrd Then tashfertable.rar تحياتي

وعليكم السلام ورحمة الله وبركاته لم يتوقف البرنامج ولكن جدول table1 غير موجود والموجود جدول table12 لو اردنا استخدامه ولكن به مشكلة ايضاً فبه حقول مطلوبة مثل txtbyan و txtdes جرب الدخول باسم : محمد وكلمة المرور : 123 tashfertable.rar تحياتي

وعليكم السلام ورحمة الله وبركاته الافضل ان تقوم بعمل تصفية للنموذج كالتالي Dim myCriteria As String If IsNull(Me.C) Then myCriteria = myCriteria & "(" myCriteria = myCriteria & "[nmsaf]= '" & Me.a.Value & "'" myCriteria = myCriteria & ")" 'Debug.Print myCriteria Me.Form.Filter = myCriteria Me.Form.FilterOn = True Else myCriteria = myCriteria & "(" myCriteria = myCriteria & "[nmsaf]= '" & Me.a.Value & "'" myCriteria = myCriteria & " or " myCriteria = myCriteria & "[Fsl]= '" & Me.C.Value & "'" myCriteria = myCriteria & ")" 'Debug.Print myCriteria Me.Form.Filter = myCriteria Me.Form.FilterOn = True End If KEN44.accdb تحياتي