عمر ضاحى

جرب الحل هذا 
 
=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 لسه ما فكرت فيهم 
لكن خليهم عند التجربه 
انا لغيت الاكواد التى وضعتيها ووضعت ليكي مديول وصب 

اتفضل الحل 
اولا لحساب العمر وفترة العمل فى دالة واحده 
اتفضل هذا المديول
Function CalcAge(StartDate As Date, EndDate As Date) As String Dim years As Integer Dim months As Integer Dim days As Integer Dim intH As Integer intH = Int(DateDiff("m", StartDate, EndDate)) + _ (EndDate < DateSerial(Year(EndDate), Month(EndDate), Day(StartDate))) years = Int(intH / 12) months = intH Mod 12 days = DateDiff("d", DateAdd("m", intH, StartDate), EndDate) CalcAge = years & " سنة و " & months & " شهر و " & days & " يوم" End Function  
وهذا الاستعلام  شامل كل شئ

 
SELECT tbl_info_fonctionnaire.num, tbl_info_fonctionnaire.nom_arabe, tbl_info_fonctionnaire.prenom_arabe, tbl_info_fonctionnaire.date_naissance, tbl_info_fonctionnaire.date_premiere_grade_poste, tbl_info_fonctionnaire.date_grade_poste_actuel, CalcAge([date_naissance],Date()) AS CalculateAge, CalcAge([date_premiere_grade_poste],Date()) AS WorkAge, DateAdd("yyyy",60,[date_naissance]) AS After60Y, DateAdd("m",18,[date_premiere_grade_poste]) AS After18M FROM tbl_info_fonctionnaire;  
النتيجة

المرفق
BASEF.rar

استبدل المعادلة ال انت عاملها 
بالمعادلة ال انا مديهالك 
واجعلها هكذا 
CalcVac(DateDiff("d";[Date_jop];Date());DateDiff("yyyy";[DateOfBirth];Date())) زان شاء الله هتظبط معاك
VACATIONS22.rar 

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

اتفضلى 
على فرض ان اسم النموذج هو Test
 
Sub RenameFields() Dim frm As Form Dim ctrl As Control Dim fieldCount As Integer fieldCount = 1 'السطر التالى اختياري الغرض منه لكي يعمل الكود دون مشاكل لابد ان يكون النموذج المطلوب العمل عليه فى وضع عرض التصميم DoCmd.OpenForm "TEST", acDesign Set frm = Forms("Test") For Each ctrl In frm.Controls If ctrl.ControlType = acTextBox And ctrl.Tag = "*" Then ctrl.Name = "officena" & Format(fieldCount, "00") fieldCount = fieldCount + 1 End If Next ctrl End Sub  
ملاحظه
علشان يشتغل الكود صحيح لابد ان يكون النموذج المطلوب العمل عليه فى وضع عرض التصميم

الملاحظات
  1- لا تضع رموز غريبه فى مسميات الحقول فى الجداول
  2- يجب ان تكون الحقول التى سيتم عمل العلاقات بينهم من نفس النوع ( فبما ان الحقول الرئيسية فى الجداول الفرعية من نوع ترقيم تلقائى او رقم فهو يعتبر رقم لذا يجب ان يكون المقابل لها فى الحقول فى الجدول الرئيسي من نفس النوع "رقمي" )
 
انظر الى الصورة التالية 
توضح لك جذء من صور العلاقات المختلفة فى الاكسيس
 

 


هناك الكثير من المواضيع التى تتكلم عن صور العلاقات بين الجداول
انصحك ان تبحث عنها وتقرئها جيدا سوف تفيدك مستقبليا كثيرا

اتفضل 
هل هذا ما تريده ؟
مثال.rar
هذه صورة لنتيجة ما تم فعله

 

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

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

 
 
List.rar

هل هكذا تريدها ؟

اذا نعم 
اتفضل هذا الملف
AAA.rar

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

قمت باضافة حقلين جدد 
وهو Other والمقصود منه Type بصراحة كسلت اعدلها ^_^ (اى نوع الفورم "هل هو نموذج ام تقرير")
واضفة ايضا ObjName اسم العنصر (اسم الفورم الذى سوف يفتح من الشجرة)

ثم قمت باضافة هذا الكود 
On Error GoTo HandleError Dim IDListObj, IDPriName As Double Dim strObjName, xOtheR As String 'هنا انا بحدد رقم المعرف للفورم من الشجرة لانه هيكون هو معياري IDListObj = Right(Me.TreeView2.SelectedItem.Key, Len(Me.TreeView2.SelectedItem.Key) - 1) ' IDPriName = Nz(DLookup("[Code]", "[Family]", "[ID] =" & IDListObj & "")) 'انا هنا بحاول اوصل لاسم الفورم او التقرير المسجل فى الجدول الخاص ب الاسم المسجل فى الشجرة strObjName = DLookup("[ObjName]", "[Family]", "[ID]=" & IDListObj & "") 'هنا انا محتاج اعرف نوع العنصر ال هيفتح هل هو فورم ولا تقرير xOtheR = DLookup("[Other]", "[Family]", "[ID]=" & IDListObj & "") ' MsgBox IDPriName & " - " & strObjName & " - " & xOtheR 'هنا الكود الخاص بعملية الفتح للنماذج او التقارير If strObjName = "Close" Then Select Case MsgBox(Buttons:=vbYesNo + vbQuestion, Prompt:="هل تريد غلق البرنامج؟", Title:="تنبيه!") Case vbYes DoCmd.Quit acQuitSaveAll Case vbNo Exit Sub End Select Else If xOtheR = "Report" Then DoCmd.OpenReport strObjName, acViewPreview ElseIf xOtheR = "Form" Then DoCmd.OpenForm strObjName, , , , , acDialog End If End If HandleExit: Exit Sub HandleError: If err.Number = 0 Then Exit Sub ElseIf err.Number = 94 Then ' MsgBox "لم يتم تسجيل اسم النموذج فى القائمه بعد؛؛؛" Exit Sub ElseIf err.Number = 2478 Then Exit Sub Else MsgBox err.Number & vbNewLine & vbNewLine & err.DESCRIPTION End If Resume HandleExit  
 
اخير اتفضل الملف بعد التعديل
شجرة TREE.rar

جرب كده 
هل هذا المطلوب ؟
 
Database6.accdb

اتمني هذا يكون طلبك 
Database29.accdb

On Error GoTo HandleError Dim ObjName As String Select Case CurrentProject.AllForms(ObjName).IsLoaded Case ObjName = "FrmAddNewPOTally" txtLPOID = Forms![FrmAddNewPOTally]![cbIDPO] If DLookup("[LPOID]", "[TblChicPO]", "[LPOID] =" & [Forms]![FrmAddNewPOTally]![cbIDPO] & "") = txtLPOID Then Call LodInfo cmdEdit.Enabled = True Else MsgBox "DataBase Not Have Any Information For List Document For PO ID# " & txtLPOID, vbCritical, "Worning" cmdSave.Enabled = True End If Case ObjName = "FromPoTallySearch" txtLPOID = Forms![FromPoTallySearch]![SubFromPoTally].Form![txtIDPO] If DLookup("[LPOID]", "[TblChicPO]", "[LPOID] =" & [Forms]![FrmAddNewPOTally]![cbIDPO] & "") = txtLPOID Then Call LodInfo cmdEdit.Enabled = True Else MsgBox "DataBase Not Have Any Information For List Document For PO ID# " & txtLPOID, vbCritical, "Worning" cmdSave.Enabled = True End If End Select HandleExit: Exit Sub HandleError: If Err.Number = 0 Then Exit Sub ElseIf Err.Number = 2467 Then Exit Sub ' ElseIf Err.Number = 2478 Then ' Exit Sub Else MsgBox Err.Number & vbNewLine & vbNewLine & Err.DESCRIPTION End If Resume HandleExit  
بالطريقه دي اشتغلت لكن بيظهر لى خطأ 2467 
وده معناه انه بيبحث عن نموذج مش مفتوح 
 
هرجع لدالة if وامري الى الله ^_^

="TOTAL " & Format([txtTotal];"#,###.00")  

اتفضل 
قمت برفع البرنامج كامل
 

ظبطة لما حذفت double
وجعلتها هكذا
Dim FORAMOUNT
او 
Dim FORAMOUNT As String

بالنسبه للنقطه رقم 1 
ممكن تعدل كود البحث باستخدام دالة len
If IsNull(Me.searchtext) Or Me.searchtext = "*" Then MsgBox "لم تقم بكتابة عبارة البحث": Exit Sub ElseIf Len(searchtext) < 3 Then MsgBox "عدد الاحرف المكتوبة اقل من 3 احرف": Exit Sub ElseIf Len(searchtext) >= 3 Then a1.Visible = True a2.Visible = True a3.Visible = True a4.Visible = True sq1 = " SELECT [On air 4G info sites].المعرف, [On air 4G info sites].GOV, [On air 4G info sites].Region, [On air 4G info sites].[Coverage Area] FROM [On air 4G info sites] WHERE ((([On air 4G info sites].[Coverage Area]) Like ""*"" & [forms]![form1]![searchtext] & ""*""));" Me.RecordSource = sq1 End If