Shivan Rekany

السلام عليكم انا الان استخدم موبايل لذلك قمت بتحويل سؤالك الی chatgpt وهذا هو جوابه ، جربه ووافينا بالنتيجة لإضافة كلمة سر عند محاولة قراءة الباركود باستخدام VBA في Microsoft Access، يمكنك استخدام الخطوات التالية لإنشاء نموذج يتطلب إدخال كلمة مرور قبل عرض البيانات المرتبطة بالباركود. إنشاء نموذج لإدخال الباركود وكلمة المرور: قم بإنشاء نموذج جديد في Access يحتوي على حقل نص لإدخال الباركود (مثل txtBarcode) وحقل نص لإدخال كلمة المرور (مثل txtPassword)، وزر لتحقق من الباركود (مثل btnVerify). إضافة الكود للتحقق من كلمة المرور والباركود: استخدم الحدث On Click للزر btnVerify للتحقق من صحة الباركود وكلمة المرور وعرض البيانات إذا كانت صحيحة. إليك مثالاً على كيفية القيام بذلك: 1. تصميم النموذج افتح قاعدة بيانات Access. قم بإنشاء نموذج جديد بالتصميم الذي ترغب فيه. أضف الحقول النصية التالية: txtBarcode: لإدخال الباركود. txtPassword: لإدخال كلمة المرور. أضف زرًا للتحقق من المدخلات (btnVerify). 2. إضافة كود VBA افتح النموذج في وضع التصميم. حدد الزر btnVerify، ثم اذهب إلى الخصائص (Properties). انقر على علامة التبويب "Event" ثم انقر على زر "..." بجانب "On Click". أضف الكود التالي: Private Sub btnVerify_Click() Dim barcode As String Dim password As String Dim correctPassword As String ' قراءة الباركود وكلمة المرور المدخلة barcode = Me.txtBarcode.Value password = Me.txtPassword.Value ' كلمة المرور الصحيحة (يمكن تخزينها في مكان آمن بدلاً من الكود) correctPassword = "1234" ' قم بتغيير كلمة المرور كما تراه مناسباً ' التحقق من كلمة المرور If password = correctPassword Then ' التحقق من الباركود If Not IsNull(DLookup("FieldName", "TableName", "BarcodeField = '" & barcode & "'")) Then ' عرض البيانات إذا كانت صحيحة MsgBox "تم التحقق بنجاح! عرض البيانات الخاصة بالباركود." ' يمكنك إضافة الكود هنا لفتح نموذج آخر أو عرض البيانات بأي طريقة تريدها Else MsgBox "باركود غير صحيح." End If Else MsgBox "كلمة مرور غير صحيحة." End If End Sub الشرح: barcode: المتغير لتخزين الباركود المدخل. password: المتغير لتخزين كلمة المرور المدخلة. correctPassword: كلمة المرور الصحيحة التي يمكن تخزينها بأمان في مكان آخر بدلاً من الكود. DLookup: وظيفة للبحث عن الباركود في جدول البيانات. قم بتغيير FieldName, TableName, و BarcodeField لتناسب أسماء الحقول والجداول في قاعدة بياناتك. هذا الكود يتحقق من صحة كلمة المرور أولاً، وإذا كانت صحيحة، يتحقق من وجود الباركود في قاعدة البيانات. إذا كان كلاهما صحيحًا، يتم عرض رسالة تأكيد، ويمكنك تعديل الكود لعرض البيانات الفعلية أو تنفيذ أي إجراء آخر

نعم يمكنك تغيره باسماء اللي حضرتك تريده نعم سيحذف كل شيء في ريجيستري وسيعود الي وضعه الاصلي

لا , لا يمكن لانه لا يعرف ماذا حفظت في ريجيستري بالتفصيل , واذا عرف ذلك نعم يمكن ... بهذه الطريقة حسب المثال الاعلى DeleteSetting "aa", "bb", "trial"

والجواب حسنا سنضيف اليه مسج التاكيدية نعم , بواسطة هذا موديول '---------------------------------- 'API CONSTANTS FOR PRIVATE INPUTBOX '---------------------------------- Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long '---------------------------------- 'PRIVATE PASSWORDS FOR INPUTBOX '---------------------------------- '//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'March 2003 '//////////////////////////////////////////////////////////////////// Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Function InputBoxDK(Prompt, Title) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title) UnhookWindowsHookEx hHook End Function وفي خلف الزر الحذف سنكتب هكذا Private Sub BtnDelete_Click() If Me.NewRecord = True Then Exit Sub Dim MyPass, MyId MyPass = InputBoxDK("للحذف السجل اكتب رقم سري الخاص بالحذف السجلات", "تأكيد الحذف") If MyPass = 9999 Then MyId = Me.ID If MsgBox("هل انت متأكد من حذف السجل" & " ( " & MyId & " ) " & "؟ عند اختيار ( نعم ) لا يمكنك الرجوع عنه ", vbYesNo, "رسالة تأكيدية") = vbYes Then DoCmd.SetWarnings False DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True MsgBox "تم حذف السجل رقم " & " ( " & MyId & " ) " & "بنجاح" Else MsgBox "تم الغاء العملية الحذف " End If ElseIf Len(MyPass & "") = 0 Then MsgBox "تم الغاء العملية الحذف" Else MsgBox "خطأ في رقم سري الخاص لحذف السجلات" End If End Sub واليكم المرفق DeleteWithPassword.accdb

السلام عليكم ورحمة الله اتفضل اخي اليك هذا الكود Private Sub BtnDelete_Click() If Me.NewRecord = True Then Exit Sub Dim MyPass, MyId MyPass = InputBox("للحذف السجل اكتب رقم سري الخاص بالحذف السجلات", "تأكيد الحذف") If MyPass = 9999 Then MyId = Me.ID DoCmd.SetWarnings False DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord DoCmd.SetWarnings True MsgBox "تم حذف السجل رقم " & " ( " & MyId & " ) " & "بنجاح" ElseIf Len(MyPass & "") = 0 Then MsgBox "تم الغاء العملية الحذف" Else MsgBox "خطأ في رقم سري الخاص لحذف السجلات" End If End Sub واليك ملف تطبيقي DeleteWithPassword.accdb

لا لكن تقدر تأخذ نسخة احتياطية من صيغة mdb وتحفظه واذا احتجت لذلك فقط قم بتبديل الجداول من القاعدة mde الى قاعدة mde

اتفضل Database3.mdb

السلام عليكم ورحمة الله لكن عندي يفتح عادي القي نظرتا الى الفيديو مصنع الصيغ مسجل الشاشة٢٠٢١٠٩٢٥_٢١٢٨٤١.rar اذا اخبرنا ماذا يجري عندك ؟

ألسلام عليكم ورحمة الله استاذ @أبو عبدالله الحلوانى قلت لك ان ... كما مبينة في الصورة وعلى مرفقك عملت ذلك القي نظرتا اليه رسالة تنبيه عند لصق بان بيانات السجل موجودة سابقة.rar تحياتي

حسب رغبتك تقدر تتغيره لكن يجب ان يكون تغيره في القاعدة الاخرى ايضا

السلام عليكم لماذا تريد شيء كهذا ؟ المبرمجون يعملون ويريدون ان يسهل للمستخدمين العمل علی الجهاز لكن حضرتك راح تصعب عليهم ، ممكن تخبرنا عن سببه ؟

نفترض ان حقل ( الادارة ) في الجدول المستخدمين يوزرس هو حقل اعطاء صلاحية لكل مستخدم , اذا كان مقابل هذا الحقل لأي مستخدم يساوي علامة صح راح يظهر له كل سجلات واي مستخدم ليس له علامة صح في ذلك الحقل فقط راح يظهر له سجلات تابعه , حينئذ راح نستخدم هذا الكود Private Sub Form_Open(Cancel As Integer) DoCmd.Maximize If DLookup("[الادارة]", "users", "[USERNAME]='" & Me.اسم__المستخدم & "'") = True Then Me.Form.RecordSource = "ادخال البيانات" Else Me.Form.RecordSource = "SELECT [ادخال البيانات].ID, [ادخال البيانات].[اسم الموقع], [ادخال البيانات].الرخصة, [ادخال البيانات].النشاط, [ادخال البيانات].المنطقة, [ادخال البيانات].[حالة الموقع], [ادخال البيانات].[رقم الهاتف الارضى], [ادخال البيانات].[رقم الهاتف المتحرك], [ادخال البيانات].[اسم مسؤول الموقع], [ادخال البيانات].الايميل, [ادخال البيانات].العدد, [ادخال البيانات].[اسم المستخدم] FROM [ادخال البيانات] WHERE ((([ادخال البيانات].[اسم المستخدم])=[Forms]![ادخال بيانات المواقع]![اسم المستخدم]));" End If End Sub واليك المرفق بعد تعديل mm (1).rar

اتفتضل تم اضافة هذا الكود عند فتح النموذج Private Sub Form_Open(Cancel As Integer) If Me.اسم__المستخدم = 1 Then Me.Form.RecordSource = "ادخال البيانات" Else Me.Form.RecordSource = "SELECT [ادخال البيانات].ID, [ادخال البيانات].[اسم الموقع], [ادخال البيانات].الرخصة, [ادخال البيانات].النشاط, [ادخال البيانات].المنطقة, [ادخال البيانات].[حالة الموقع], [ادخال البيانات].[رقم الهاتف الارضى], [ادخال البيانات].[رقم الهاتف المتحرك], [ادخال البيانات].[اسم مسؤول الموقع], [ادخال البيانات].الايميل, [ادخال البيانات].العدد, [ادخال البيانات].[اسم المستخدم] FROM [ادخال البيانات] WHERE ((([ادخال البيانات].[اسم المستخدم])=[Forms]![ادخال بيانات المواقع]![اسم المستخدم]));" End If End Sub واليك قاعدتك بعد اضافة الكود mm.rar

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

قم بالتحكم والتحدید مصدر النموذج عند فتحه اذا كان هو مدير هو بيفتحه غير مصدر النمذج الی جدول او اذا كان اللي بيفتح النموذج هو مستخدم عادي غير مصدر النموذج الی استعلام به شرط ، والشرط هو حقل المستخدمين في الجدول البيانات يساوي اسم المستخدم اللي فتح النموذج اي يساوي مستخدم الحالي تحياتي

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

اتفضل اليك هذا استعلام SELECT Root() AS Exprt1; اليك ملفك بعد اضافة استعلام Root2211.rar

Dim Numbers if len(SText & "")=0 then GetNumbersOnly="" exit function end if For i = 1 To Len(SText) If IsNumeric(Mid(SText, i, 1)) and Mid(SText, i, 1) <> 0 Then Numbers = Numbers & Mid(SText, i, 1) End If Next GetNumbersOnly = Trim(Numbers) اتفضل تم اضافة هذا جزء فقط and Mid(SText, i, 1) <> 0

هذه العلامه <> يعني غير متساوي مع NZ هذه الدالة بيعمل لك تغير قيمة اذا كان لا شيء الی القيمة اللي تكتب في اخره اي معنی جملة كاملة هو ان لا يكون متساوي مع حقل اللي في نموذج اللي اسمه تحويل العملات و اسم الحقل اي مربع نصي تحويل من واذا كان حقل تحويل من بيكون لاشي غير قيمة الحقل الی صفر تحياتي

مشاركة مع استاذ @husamwahab اتفضل اليك كلتا الطريقين تقدر تستخدم طريقة ان لا يظهر نوع العملة اللي تدخل في حقل تحويل من في مصدر تحويل الى او تقدر تستخدم هذا الكود قبل تحديث للحقل تحويل من و تحويل الى Private Sub تحويل_الى_BeforeUpdate(Cancel As Integer) If Len(Me.تحويل_من & "") <> 0 And Me.تحويل_من = Me.تحويل_الى Then MsgBox "لا يجوز ادخال نفس نوع العملة في الحقل تحويل من و تحويل الى " Cancel = True End If End Sub Private Sub تحويل_من_BeforeUpdate(Cancel As Integer) If Len(Me.تحويل_من & "") <> 0 And Me.تحويل_من = Me.تحويل_الى Then MsgBox "لا يجوز ادخال نفس نوع العملة في الحقل تحويل من و تحويل الى " Cancel = True End If End Sub استخدمت كلتا طريقين في مرفقك 1.zip

اذا كان الحقل من نوع الرقمي استخدم هذا =DLookup("[AVAILABLE STOCK]";"[QR_PRODUCT]";"[[QR_PRODUCT]]![ITEM_COD]=" & Me.ITEM_COD) واذا کان الحقل من نوع نصی استخدم ھذا =DLookup("[AVAILABLE STOCK]";"[QR_PRODUCT]";"[[QR_PRODUCT]]![ITEM_COD]='" & Me.ITEM_COD & "'")

استخدم دالة DLookup مع شرط كودالصنف في الاستعلام يساوي كود الصنف في النموذج المبيعات

اذا كان ايام الحضور 26يوما في شهر قم بعمل الاتي ايام الغياب يساوي 26 ناقص ايام الحضور اي 26 - عدد ايام الحضور في الشهر او اذا هناك شيء اخر تبحثه وضحه سؤالك اكثر تحياتي

اتفضل ماتريده dlookup.rar

اتفضل اليك هذا الكود Private Sub ÃãÑ32_Click() Dim Db As DAO.Database Dim Rs As DAO.Recordset Dim i As Integer Set Db = CurrentDb Set Rs = Db.OpenRecordset("Table1") If Rs.RecordCount = 0 Then Exit Sub Rs.MoveLast: Rs.MoveFirst For i = 1 To Rs.RecordCount DoCmd.OpenReport "Rep1", acViewNormal, , "[id]=" & Rs![ID] DoCmd.OpenReport "Rep2", acViewNormal, , "[id]=" & Rs![ID] DoCmd.OpenReport "Rep3", acViewNormal, , "[id]=" & Rs![ID] DoCmd.OpenReport "Rep4", acViewNormal, , "[id]=" & Rs![ID] DoCmd.OpenReport "Rep5", acViewNormal, , "[id]=" & Rs![ID] DoCmd.OpenReport "Rep6", acViewNormal, , "[id]=" & Rs![ID] DoCmd.OpenReport "Rep7", acViewNormal, , "[id]=" & Rs![ID] DoCmd.OpenReport "Rep8", acViewNormal, , "[id]=" & Rs![ID] Rs.MoveNext Next i Db.Close Set Db = Nothing Set Rs = Nothing End Sub واليك قاعدة تجريبية 8REP.rar