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

هذه محاولة ومع التجربة وجدت انها اسرع احذف اولاً الكود الموجود وضع الكود التالي في vba Private Sub Form_Load() '1 Me.mois1 = Format(Date, "mm/yyyy") Me.mois2 = Format(DateAdd("m", 1, Date), "mm/yyyy") Me.mois3 = Format(DateAdd("m", 2, Date), "mm/yyyy") Me.mois4 = Format(DateAdd("m", 3, Date), "mm/yyyy") Me.mois5 = Format(DateAdd("m", 4, Date), "mm/yyyy") Me.mois6 = Format(DateAdd("m", 5, Date), "mm/yyyy") Me.mois7 = Format(DateAdd("m", 6, Date), "mm/yyyy") Me.mois8 = Format(DateAdd("m", 7, Date), "mm/yyyy") Me.mois9 = Format(DateAdd("m", 8, Date), "mm/yyyy") Me.mois10 = Format(DateAdd("m", 9, Date), "mm/yyyy") Me.mois11 = Format(DateAdd("m", 10, Date), "mm/yyyy") Me.mois12 = Format(DateAdd("m", 11, Date), "mm/yyyy") Me.mois13 = Format(DateAdd("m", 12, Date), "mm/yyyy") 'das2_1 das2_1 = _ Nz(DSum("ca_moiss1", "phase_chantier", "moiss1>=[mois1] and moiss1<[mois2] "), 0) + _ Nz(DSum("ca_moiss2", "phase_chantier", "moiss2>=[mois1] and moiss2<[mois2] "), 0) + _ Nz(DSum("ca_moiss3", "phase_chantier", "moiss3>=[mois1] and moiss3<[mois2] "), 0) + _ Nz(DSum("ca_moiss4", "phase_chantier", "moiss4>=[mois1] and moiss4<[mois2] "), 0) + _ Nz(DSum("ca_moiss5", "phase_chantier", "moiss5>=[mois1] and moiss5<[mois2] "), 0) + _ Nz(DSum("ca_moiss6", "phase_chantier", "moiss6>=[mois1] and moiss6<[mois2] "), 0) + _ Nz(DSum("ca_moiss7", "phase_chantier", "moiss7>=[mois1] and moiss7<[mois2] "), 0) + _ Nz(DSum("ca_moiss8", "phase_chantier", "moiss8>=[mois1] and moiss8<[mois2] "), 0) + _ Nz(DSum("ca_moiss9", "phase_chantier", "moiss9>=[mois1] and moiss9<[mois2] "), 0) + _ Nz(DSum("ca_moiss10", "phase_chantier", "moiss10>=[mois1] and moiss10<[mois2] "), 0) + _ Nz(DSum("ca_moiss11", "phase_chantier", "moiss11>=[mois1] and moiss11<[mois2] "), 0) + _ Nz(DSum("ca_moiss12", "phase_chantier", "moiss12>=[mois1] and moiss12<[mois2] ")) 'das2_2 das2_2 = _ Nz(DSum("ca_moiss1", "phase_chantier", "moiss1>=[mois2] and moiss2<[mois3] "), 0) + _ Nz(DSum("ca_moiss2", "phase_chantier", "moiss2>=[mois2] and moiss2<[mois3] "), 0) + _ Nz(DSum("ca_moiss3", "phase_chantier", "moiss3>=[mois2] and moiss3<[mois3] "), 0) + _ Nz(DSum("ca_moiss4", "phase_chantier", "moiss4>=[mois2] and moiss4<[mois3] "), 0) + _ Nz(DSum("ca_moiss5", "phase_chantier", "moiss5>=[mois2] and moiss5<[mois3] "), 0) + _ Nz(DSum("ca_moiss6", "phase_chantier", "moiss6>=[mois2] and moiss6<[mois3] "), 0) + _ Nz(DSum("ca_moiss7", "phase_chantier", "moiss7>=[mois2] and moiss7<[mois3] "), 0) + _ Nz(DSum("ca_moiss8", "phase_chantier", "moiss8>=[mois2] and moiss8<[mois3] "), 0) + _ Nz(DSum("ca_moiss9", "phase_chantier", "moiss9>=[mois2] and moiss9<[mois3] "), 0) + _ Nz(DSum("ca_moiss10", "phase_chantier", "moiss10>=[mois2] and moiss10<[mois3] "), 0) + _ Nz(DSum("ca_moiss11", "phase_chantier", "moiss11>=[mois2] and moiss11<[mois3] "), 0) + _ Nz(DSum("ca_moiss12", "phase_chantier", "moiss12>=[mois3] and moiss12<[mois3] ")) End Sub ثم اكمل باقي الحقول بنفس الطريقة تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then ctl.Value = Null End If Next ctl تحياتي

جزاك الله خيرا استانا الفاضل @ابا جودى على هذا العمل الرائع واثراءا للموضوع اسمح لي بتطبيق الفكرة بشكل اخر مختصر بعض الشىء Private Sub XH_S() If Me.sec.Value = "سري" Then Me.Label12.Visible = True Else Me.Label12.Visible = False End If End Sub Private Sub Form_Current() Me.مربع_تحرير_وسرد7.SetFocus XH_S End Sub Private Sub Form_Open(Cancel As Integer) XH_S End Sub Private Sub مربع_تحرير_وسرد7_AfterUpdate() Me.Filter = "noo =" & Me.مربع_تحرير_وسرد7 Me.FilterOn = True Me.Requery If Me.sec.Value = "سري" Then ' Me.Visible = False If InputBox("الرجاء ادخال كلمة السر لفتح النموذج", "فتح النموذج") = "123" Then Me.Label12.Visible = False Else ' Me.Visible = False Me.Label12.Visible = True End If End If End Sub b21.accdb تحياتي

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

وعليكم السلام ورحمة الله وبركاته اضعط زر Shift + زر 6 بالاعلى ^ تحياتي 10^9

وعليكم السلام ورحمة الله وبركاته استخدم الكود التالي لاظهار نافذة تصدير التقرير الى الصيغة التي تريدها DoCmd.OutputTo acReport, "rpt1" تحياتي

وعليكم السلام ورحمة الله وبركاته بالاضافة الى ما تفضل به استاذنا الفاضل @ابوخليل وله الشكر جرب الكود التالي Me.Filter = "noo =" & Me.مربع_تحرير_وسرد7 Me.FilterOn = True Me.Requery If Me.sec.Value = "سري" Then Me.Visible = False If InputBox("الرجاء ادخال كلمة السر لفتح النموذج", "فتح النموذج") = "123" Then Me.Visible = True Else Me.Visible = False DoCmd.GoToRecord , , acNewRec End If End If b21.accdb تحياتي

تفضل اخي الكريم هذه طريقة افضل واسرع ضع الكود التالي في وحدة نمطية جديدة Public Function XNul(txt1 As Double, txt3 As Double) As Double If Nz(txt1, 0) > 0 And Nz(txt3, 0) > 0 Then XNul = (txt1 / txt3) * 100 Else XNul = 0 End If End Function ثم في الاستعلام ضع التالي مع تغيير اسماء الحقول Expr1: XNul(Nz([المدفوعات]);Nz([صافى الفواتير])) تحياتي

وعليكم السلام ورحمة الله وبركاته ضع الكود في وحدة نمطية وغير Private الى Public مؤشر.rar تحياتي

ارفق مثال بارك الله فيك تحياتي

وعليكم السلام ورحمة الله وبركاته هذا هو الحل الافضل نظرا لكثرة العمليات ارفق مثال بارك الله فيك تحياتي

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

لإثراء الموضوع تفضل اخري الكريم Private Sub السيارة_جاهزة_Click() If Me.السيارة_جاهزة = True Then Me.السيارة_مغادرة = False End Sub Private Sub السيارة_مغادرة_Click() If Me.السيارة_مغادرة = True Then Me.السيارة_جاهزة = False End Sub او Private Sub السيارة_جاهزة_Click() Select Case Me.السيارة_جاهزة Case Me.السيارة_جاهزة = True Me.السيارة_مغادرة = False End Select End Sub Private Sub السيارة_مغادرة_Click() Select Case Me.السيارة_مغادرة Case Me.السيارة_مغادرة = True Me.السيارة_جاهزة = False End Select End Sub تحياتي

بالاضافة الى ما تفضل به استاذنا الفاضل @kanory وله جزيل الشكر تفضل احي الكريم Dim rst As DAO.Recordset Set rst = Me.Recordset.Clone rst.FindFirst "[noo] = " & Me.مربع_تحرير_وسرد7 Set rst = Nothing b2.accdb تحياتي

وعليكم السلام ورحمة الله وبركاته لا يتم عمل باسورد على الجداول ولكن يمكن التحكم في النموذج المرتبط بجدول عند فتحه بكلمة سر كالتالي If InputBox("الرجاء ادخال كلمة السر لفتح النموذج", "فتح النموذج") = "123" Then DoCmd.OpenForm "frm1" Else MsgBox "عفوا .. كلمة السر خاطئة ", vbOKOnly + vbCritical, "خطأ في كلمة السر" DoCmd.Close acForm, "frm1" End If تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل هذه تجرية iif(nz([المدفوعات])>0;(nz(المدفوعات)/nz(صافى الفواتير))*100;0) تحياتي

تفضل اخي الكريم Private Sub NO_AfterUpdate() DoCmd.SetWarnings False DoCmd.OpenQuery "Query1" DoCmd.SetWarnings True End Sub Private Sub NO_Exit(Cancel As Integer) Me.Requery End Sub Private Sub رقم_الموظف_GotFocus() DoCmd.GoToControl "NO" End Sub بيانات الموظفين.accdb تحياتي

تفضل احي الكريم استبدال الكود الموجود بالكود الجديد Private Sub NO_Exit(Cancel As Integer) Me.Requery DoCmd.SetWarnings False DoCmd.OpenQuery "Query1" DoCmd.SetWarnings True Me.رقم_الموظف.SetFocus Me.NO.SetFocus End Sub بيانات الموظفين.accdb تحياتي

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام استعلام الحاق لتفيذ الجزء الاول DoCmd.SetWarnings False DoCmd.OpenQuery "Query1" DoCmd.SetWarnings True وللجزء الثاني استخدم الكود التالي Me.NO.SetFocus Me.NO = "" بيانات الموظفين.accdb تحياتي

وعليكم السلام ورحمة الله وبركاته في قاعدة البيانات لديك مكتبات غير متوفرة في الجهاز الجديد يمكن تحميلهم من الانترنت او نسخهم من الجهاز الاول الى الجهاز الجديد ستجدهم في المسار التالي windows 32 bit C:\Windows\System32 windows 64 bit C:\Windows\SysWOW64 والمكتبات المطلوبة هي Aec32BitAppServer57.tlb accessibility.api تحياتي

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

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم if text=123 then me.form.filteron = true else me.form.filteron = false endif تحياتي

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

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام office runtime سيقوم بتشغيل الاكسيس بدون امكانية التعديل على التصميم https://www.microsoft.com/en-us/download/details.aspx?id=50040 تحياتي

يوحد لديك في قاعدة البيانات مكتبة vsflex7l.ocx وتحتاج الى اضافتها الى ويندوز الجهاز الجديد يمكن تحميلها من الرابط التالي https://www.ocxme.com/files/vsflex7l_ocx ثم ضعها في المسار التالي ويندوز 32 C:\Windows\System32 ويندوز 64 C:\Windows\SysWOW64 تحياتي