Amr Ashraf

شرفنى مرورك اخى الكريم

السلام عليكم .. الاساتذة الكرام الموضوع اليوم عن تتبع التغييرات التى تقوم بها على اى سجل موجود فى قاعدة البيانات .. لنبدأ لنفترض ان لدى مجموعة من النماذج التى تقوم بتعديل بيانات معينة فى الجداول واريد ان اتتبع التغييرات التى تمت بحيث يتم تسجيل البيانات قبل التعديل وبعد التعديل مثال : لدى هذا النموذج ومهمته التعديل على رصيد المخزن .. انظر للقيمة قبل التعديل : قمت بالتعديل وضغطت على زر الأمر .. النتيجة .. فى جدول التعديلات TblAudit تم تسجيل التالى : القيمة قبل التعديل وبعد التعديل .. والشخص القائم بالتعديل .. وتاريخ ووقت التعديل .. و النموذج المستخدم فى التعديل .. ومصدر بيانات هذا النموذج . فلنجرب تعديل اكثير من حقل فى النموذج دفعة واحدة : النتيجة : تابع معى لتعرف الطريقة : مبدأياً لم اكتب الكود ولكن قمت بالتعديل عليه وعملت امثلة مصمم الكود كتبت اسمها فى الكود نفسه .. افتح موديول جديد والصق هذا الكود : Public Function WriteAudit(frm As Form, lngID As Long) As Boolean On Error GoTo err_WriteAudit Dim ctlC As Control Dim strSQL As String Dim bOK As Boolean bOK = False DoCmd.SetWarnings False ' For each control. For Each ctlC In frm.Controls If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then If Not IsNull(ctlC.Value) Then strSQL = "INSERT INTO tblAudit ( ID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateofHit, FrmName , FrmRcrdSrc ) " & _ " SELECT " & lngID & " , " & _ "'" & ctlC.Name & "', " & _ "'" & ctlC.OldValue & "', " & _ "'" & ctlC.Value & "', " & _ "'" & GetUserName_TSB & "', " & _ "'" & Now & "' , " & _ "'" & M & "', " & _ "'" & R & "'" 'Debug.Print strSQL DoCmd.RunSQL strSQL End If End If End If Next ctlC WriteAudit = bOK exit_WriteAudit: DoCmd.SetWarnings True Exit Function err_WriteAudit: MsgBox Err.Description Resume exit_WriteAudit End Function اذا اردت ان تنادى هذا الكود يتم بهذه الطريقة WriteAudit(Form Name, Record ID) مثلا كالتالى فى زر امر : On Error GoTo Err_cmdClose_Click If Not IsNull(Me!ID) Then M = Me.Name ' Debug.Print M R = Me.RecordSource ' Debug.Print R X = WriteAudit(Me, Me!ID) End If DoCmd.Close Exit_cmdClose_Click: Exit Sub Err_cmdClose_Click: MsgBox Err.Description Resume Exit_cmdClose_Click ملاحظة : - يمكن استخدام الكود فى اى نموذج يقوم بتعديل البيانات وسيقوم الكود بتسجيل التعديلات وبياناتها كما اشرت سابقاً. قام استاذنا جعفر @jjafferr بعمل موضوع رائع مشابه فى الفكرة ولكن يقوم بتسجيل التعديلات التى تتم على الجداول عن طريق الماكرو يمكنك مشاهدته من هنا : مرفق مثال به نموذجين وتم استخدام نفس الاكواد فيهما .. دمتم بود Dynamic Audit Trail - Amr Ashraf.accdb

السلام عليكم .. حاولت اساعد مع الاساتذة ولكن المرفق به مشكلة على جهازى كل ما احاول ادخل وضع التصميم الاكسس يتوقف عن العمل .. لى اقتراح طالما مش بتختار نوع الحساب ومحتاجه يتكتب فيه القيمة تلقائى يبقى حول الكومبوبوكس الى حقل نصى مثلا ونضع كود فى كومبوبوكس الحساب بعد التحديث اذا كان الحساب صرف يبقى نوع الحساب حديث اما اذا كان كذا يبقى نوع الحساب كذا جملة Select Case بسيطة تحل الموضوع .. على حسب فهمى لطلبك . وطلبنا منك تبسيط المرفق للتسهيل على من يجيبك ولكنك لم تستجيب 😌.

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

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

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

بارك الله فيك اخى الكريم , شرفنى مرورك وكلماتك العطرة

بارك الله فيك استاذنا الفاضل

طريقة برايل نفسها وليست الاكواد .. سأجربها فى اقرب وقت بإذن الله 😅

بارك الله فيكم جميعاً

السلام عليكم .. #اضافة وتأكيد معلومة : كما أشار استاذنا ابو خليل ان الطريقة ليست حصراً على الزر فقط ولكن لها تطبيقات اخرى كثيرة يمكنك الاطلاع على المرفق لمزيد من التطبيقات على الفكرة ( قائمة عند الضغط على صورة - قائمة عند الضغط على F2 او F3 من الكيبورد - قائمة عند تحريك بكرة الماوس ) طبعاً مجرد امثلة والتطبيقات كثيرة جدا .. ولشرح مفصل ووافى وبلمسة ابداعية لطريقة القوائم المختصرة ارشح لك موضوع استاذنا الكبير جعفر فى الرابط التالى : دمتم بخير .. Amr Magic Button V2.0.accdb

ولك مثله اخى الكريم , شرفنى مرورك

استاذنا الغالى حسام بارك الله فيك ورفع قدرك

السلام عليكم .. اختى الفاضلة هذا عدد كبير من الملفات ولذلك لدى فكرة قد تسهل عليكى اذا كانت الملفات كلها نفس التنسيق وترتيب الاعمدة مثلا يمكننا ان نتعب الاكسيل معنا قليلاً ليساعدنا 😅 انظرى الى هذا الكود , يتم عمل موديول جديد ولصق الكود التالى به Sub LoopAllExcelFilesInFolder() Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "اختر المجلد المطلوب" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings myExtension = "*.xls*" myFile = Dir(myPath & myExtension) Do While myFile <> "" Set wb = Workbooks.Open(Filename:=myPath & myFile) DoEvents Cells.Select Selection.Copy Windows("1.xlsx").Activate Dim Rng As Range Set Rng = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) Rng.Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' wb.Close SaveChanges:=True DoEvents myFile = Dir Loop MsgBox "تمت العملية بنجاح" ResetSettings: Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub طريقة عمل الكود : يقوم بفتح كل ملفات الاكسيل فى مجلد تقومين باختياره ويقوم بنسخ محتوياته ولصقها فى شيت اكسيل اسمه 1.xlsx ويجب ان يكون هذا الشيت مفتوح ليقوم بلصق المحتويات فيه .. عملية اللصق تكون Paste Values بمعنى انها بدون تنسيق او معادلات . لتشغيل الكود بعد حفظه اضغطى على Alt+F8 وقومى باختيار اسمه من قائمة الماكرو واضغطى Run وبعدها اختارى المجلد الذى يحتوى على ال500 ملف المطلوبين ثم Ok وسيقوم الاكسيل بالباقى وهو تجميع ال500 ملف فى الشيت 1.xlsx وازيدك من الشعر بيت كما قال استاذنا جعفر اذا كانت ال500 ملف بها خلية معينة بها اسم القسم يمكن تعديل الكود لكتابة اسم القسم بجانب البيانات الخاصة به وبهذا ينتج عندنا ملف واحد به كل البيانات المطلوبة ويتم لصقها فى جدول الاكسس فقط . فى حالة عدم وضوح الفكرة يمكننى عمل شرح مصور لكى .. بالتوفيق

ماشاء الله عليك , الموضوع معقد اكثر مما تصورت 😐

هل هناك مشكلة ؟

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

السلام عليكم .. اعتقد ان الطريقة مبشرة فعلا ومناسبة جدا لمطلب استاذنا ابو خليل , بارك الله فيك وزادك علماً

بارك الله فيك اخى العزيز. بارك الله فيك ورفع قدرك استاذنا الكريم

هناك الكثير من الامثلة فى المنتدى عن القوائم المنسدلة المتتابعة اخى الكريم ابحث واذا لم توفق اعمل مثال صغير به القائمتين وان شاء الله ستجد المساعدة

بارك الله فيك اخى الكريم رفع الله قدرك يا غالى

لا شكر على واجب بالتوفيق.. اختر افضل اجابة لاغلاق السؤال من فضلك

بارك الله فيك يا هندسة عقبالك احاول تطبيق ما تعلمته هنا فقط يا أستاذنا.. بارك الله فيكم

السلام عليكم ورحمة الله وبركاته , الترقيات عندكم مفاجآت والله 😮 بارك الله فى اعماركم وجزاكم خيرا على ما تقدموه , ولكنى احس اللقب ثقيل جدا على انا مازلت مبتدئ 😔 أعاننا الله عليه .. لى الشرف انى اكون جزء من هذا الطاقم الكريم . تحياتى لكم جميعاً

الطريقة الصحيحة لا تحتوى على الحاق .. فقط استعلامات للحصول على المطلوب وتتغير بتغير الرتبة التى حصل عليها الشخص .. انظر الى النتيجة أليس هو المطلوب ؟ جرب تغير تاريخ Date In او تضيف رتبة جديدة بتاريخ لاحق ستتغير النتيجة تلقائيا بدون الحاق . الاستعلام المطلوب كما بالصورة QryLastDegree جرب ووافنى بالنتيجة .. بالتوفيق 1177264532_HR-Amr.accdb