عمر ضاحى

قمت بعمل برنامج بسيط 

1- اضافة بيانات المرضي
2- اضافة بيانات المعالجين
3- التعديل على بيانات المستخدمين وصلاحيات (بطريقة بسيطه لتوضيح الفكره) واضافة جديد ايضا 
4- اضافة حركة او قيد او زيارة كما تحب ان تسميها
5- كشف حساب للمرضي
6- كشف حساب للمعالجين
7- لتبديل المستخدم
8- لغلق البرنامج
 
عند تشغيل القاعده هيظهر لى نموذج الدخول (معمول بشكل بسيط ايضا) 😅
تم تسجيل 2 مستخدمين 
الاول اسم المستخدم 1 وكلمة السر 1 (لديه جميع الصلاحيات)
الثاني اسم المستخدم 2 وكلمة السر 2 (لديه بعض الصلاحيات)
 
نزل البرنامج وحاول اولا تشوف فكرته 
واذا واجهتك اى صعوبة فى فهم الية العمل 
اسأل هنا وهشرحلك كل شئ 
 
Clinic_001.rar
 

المطلوب منك 
هتعلن عن متغير عام على مستوى النموذج
Private SortAscending As Boolean هتحتاج الى هذا الصب
 
Private Sub SortRecords(ByVal FieldName As String) Dim OrderDirection As String If SortAscending Then OrderDirection = " ASC" Else OrderDirection = " DESC" End If Me.OrderBy = FieldName & OrderDirection Me.OrderByOn = True SortAscending = Not SortAscending End Sub وفى كل تسميه هتيجي عن حدث عند الضغط
وتستدعي الصب 
مثل 
SortRecords "Nr" لاحظ انى هنا احتجت اى اسم الحقل (كما هو فى الجدول) لهذا الصب
 
 
مرفق الملف بعد التعديل
db1.rar
 
 

اخي الحبيب
انت لم تضع اى حقول فى النموذج 
فكيف تتوقع ظور اى نتائج ؟😅
 

 
فقط ضيف الحقول وكل شئ شايف شغال تمام

اخي الحبيب @moho58
حسب رسالتك معي على الخاص 
فان المشكله معاك تحدث عندما تحاول ادراج ملف بعد ان تكتب السنه او اى شئ 
وهذا يحدث بسبب الاتي 
وانك عندما تبدأ فى تسجيل مثلا السنه فانك بالفعل مازلت فى وضع السجل الجديد 
وبالتالى لما تضغط على الزر لتحديد الملف 
فانك بالفعل ايضا فى وضع السجل الجديد ومفيش معرف تم حفظه جديد علشان يتم الربط به 
وبالتالى الحل 
ان تسجل السنه واي شئ اخر انت تريده وتنتقل لاى سجل اخر علشان يتم الحفظ 
ثم بعدها ترفق الملف
 
ام ممكن تجرب فى حدث بعد التحديث ان تجعل النموذج يعمل Requery
 
مثل هذا الكود 
Private Sub annee_dossier_AfterUpdate() Form.Requery End Sub Private Sub titre_f_AfterUpdate() Form.Requery End Sub وبكده مشكلتك هتتحل ان شاء الله 
 
اتمني ان اكون قدرت اوصل لك المعلومه بشكل صحيح 

اتفضلى
 

 
No.of record.rar

اضف زر فى نموذج tabl1
واضف هذا الكود له
Dim filter As String filter = "" If Not IsNull(Me.sana) Then filter = filter & "sana = '" & Me.sana & "' AND " End If If Not IsNull(Me.rakm) Then filter = filter & "rakm = '" & Me.rakm & "' AND " End If If Not IsNull(Me.wadia) Then filter = filter & "wadia = '" & Me.wadia & "' AND " End If If filter <> "" Then filter = Left(filter, Len(filter) - 5) End If DoCmd.OpenForm "tabl", , , filter  

مش شغال ازاي ؟
شغال تمام معي

 

وهذه محاولتى مع استاذى الاستاذ موسي
base_s_w.rar
عند الضغط مرتين على حقل اسم ملف الوثيقه 
هتظهر لك نافذة تختار الملف والكود هيعملك المجلد الذى سيتم حفظ الوثيقه فيه 
واذا كان هناك ملف بالفعل وضغطة مرتين على حقل اسم ملف الوثيقه هيظهر لك رسالة تخيرك اذا تريد الاستبدال ام لا 
 
وراجع الحقول الجديده التى تم اضافتها فى الجدول 
مثل حقل SN
وحقل FileName
 

اتفضل ملف المرفق بعد التعديل 
base_cham.rar

اتفضل هذه فكرتي التى تم ذكرها سابقا
ProgressBar.rar

اتفضل طلبك
لكن انصحك نصيحه لوجه الله
لا تجعل اسماء الحقول فى الجداول بالعربي هتتعبك قدام
test(1).rar
 

ده بسبب انه حقل متعدد القيم ولا يمكن استخدام like مباشرتا
ولهذا يجب اضافة Value الى اسم الحقل [grade]
انظر للسطر التالي
 
StrWhere = StrWhere & " and [grade].Value like '*" & Me.tx1 & "*'"  

وهذا مرفق
للتوضيح
ونصيحه
لا تجعل اسماء الحقول باللغه العربيه
 
نظام شراء سيارات.rar

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

نعم يمكنك
عن طريق هذه الاداة

لكن بشرط
ان يكون الاوفيس عندك انجليزي لو عربي مش هيشتغل

بص
جرب تنقل القاعده على جهاز اخر وعلى اصدار اوفيس احدث وشوف هتشتغل ولا لا
لان الرسالة بتقول ان قاعدة البيانات فيها تلف
ممكن يكون بسبب ان فعلا قاعدة البيانات تالفه (ولا ادري السبب ممكن انت تقول ايه ال حصل بالظبط فحصل ده)
ممكن يكون ان فى ملفات مفقوده او اتحذفت
والله اعلم

جرب الحل هذا 
 
=IIf([ID] Is Null; 0; Nz(DCount("[ID]"; "[count_c]"; "ID=" & [ID]); 0))  

هذا هو السبب

لاحظ ان التاريح فى سنة 1932 خارج الحدود ال حضرتك عاملها

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

.
 
 
JO.rar
 
 

اتفضلى ما تريدين 
2 combobox.rar
 
Private Sub account_AfterUpdate() Dim strSQL As String Select Case Me.account.Value Case "فردي" ' contract.RowSource = "" contract.RowSourceType = "قائمة القيم" contract.RowSource = "بدون تعاقد;بدون تعاقد" contract.Value = "بدون تعاقد" discount.Value = "0" discount.Enabled = True Case "تعاقد" strSQL = "SELECT contract_price_tbl.code, contract_price_tbl.contract, contract_price_tbl.discount FROM contract_price_tbl;" contract.RowSourceType = "Table/Query" contract.RowSource = strSQL discount = contract.Column(2) discount.Enabled = False Case "مجاني" ' contract.RowSource = "" contract.RowSourceType = "قائمة القيم" contract.RowSource = "بدون تعاقد;بدون تعاقد" contract.Value = "بدون تعاقد" discount.Value = "100" discount.Enabled = True Case "مختبر خارجى" strSQL = "SELECT out_tbl.code, out_tbl.out FROM out_tbl;" contract.RowSourceType = "Table/Query" contract.RowSource = strSQL End Select contract.Requery End Sub  

اتفضل الحل
Omar.rar
 

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

الكود هذا من مكتبة استاذى @Moosak
 
Option Compare Database Option Explicit Public Function ShowHideRibbon(ShowRibbon As Boolean) On Error GoTo ErrHandler '*********************( إخفاء/إظهار الشريط العلوي وجميع النوافذ )************************** If ShowRibbon = False Then '--------------------------------(إخفاء الريبون والنفجيشن بان) DoCmd.ShowToolbar "Ribbon", acToolbarNo ' Hide Navigation Pane: DoCmd.NavigateTo ("acnavigationcategoryobjecttype") DoCmd.RunCommand (acCmdWindowHide) '--------------------------------(جميع تضبيطات تقفيل القاعدة وإخفاء القوائم ومنع الزر الأيمن والاختصارات) Application.SetOption "Show Status Bar", False CurrentDb.Properties("ShowDocumentTabs") = False Application.SetOption "Auto compact", True Application.SetOption "Remove Personal Information", False Application.SetOption "Themed Form Controls", False Application.SetOption "DesignWithData", False CurrentDb.Properties("AllowDatasheetSchema") = False Application.SetOption "CheckTruncatedNumFields", False CurrentDb.Properties("AllowFullMenus") = False CurrentDb.Properties("AllowShortcutMenus") = False '--------------------------------(Shift منع استخدام زر الشفت) On Error GoTo err CurrentDb.Properties("allowbypasskey") = False Exit Function ElseIf ShowRibbon = True Then '--------------------------------(إضهار الريبون والنفجيشن بان) DoCmd.ShowToolbar "Ribbon", acToolbarYes 'Unhide the navigation pane On Error Resume Next Call DoCmd.SelectObject(acTable, , True) Call DoCmd.SelectObject(acMacro, , True) Call DoCmd.SelectObject(acForm, , True) On Error GoTo ErrHandler '--------------------------------(فتح خصائص قاعدة البيانات وإظهار القوائم وتفعيل الزر الأيمن والاختصارات) Application.SetOption "Show Status Bar", True CurrentDb.Properties("ShowDocumentTabs") = True Application.SetOption "Auto compact", True Application.SetOption "Remove Personal Information", True Application.SetOption "Themed Form Controls", True Application.SetOption "DesignWithData", True CurrentDb.Properties("AllowDatasheetSchema") = True Application.SetOption "CheckTruncatedNumFields", True CurrentDb.Properties("AllowFullMenus") = True CurrentDb.Properties("AllowShortcutMenus") = True '--------------------------------(Shift السماح باستخدام زر الشفت) On Error GoTo err2 CurrentDb.Properties("allowbypasskey") = True Exit Function End If '--------------------------------------------------------------------------- ErrHandler: If err.Number <> 0 Then MsgBox err.Number & vbCrLf & vbCrLf & err.Description, , "Function: ShowHideRibbon" Resume Next Else Exit Function End If err: CurrentDb.Properties.Append CurrentDb.CreateProperty("allowbypasskey", 1, False) Exit Function err2: CurrentDb.Properties.Append CurrentDb.CreateProperty("allowbypasskey", 1, True) Exit Function End Function  
طبعا بيتم تشغيل الكود مع الاكسيس بواسطة المايكرو ( Autoexec )
مرفق ملف للتوضيح
Shift.rar

جرب هذا الكود
فى كل مره هيسألك اين تريد حفظ التقرير
وقابل للتطوير
Dim reportName, FileNameIs As String Dim fd As fileDialog Dim strFolderPath As String reportName = "RepPrintTallyPO" FileNameIs = "POs Report" Set fd = Application.fileDialog(msoFileDialogFolderPicker) If fd.Show = -1 Then strFolderPath = fd.SelectedItems(1) strFolderPath = strFolderPath & "\" & FileNameIs & ".xls" DoCmd.OutputTo acOutputReport, reportName, acFormatXLS, strFolderPath, False MsgBox "The File Saved On ( " & strFolderPath & " ) Successfully" Else MsgBox " The file has been cancelled ", vbCritical End If Set fd = Nothing  

هل هذا ما تريدين 

age collect.rar
انا وضعت تقريبا جميع الاحتمالات التى جربتها 
قد يكون هناك احتمالين او 3 لسه ما فكرت فيهم 
لكن خليهم عند التجربه 
انا لغيت الاكواد التى وضعتيها ووضعت ليكي مديول وصب