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

تم تعديل اسم مربع تحرير وسرد الى ZTeacher1 جرب الآن باسم / خالد بن عبدالله سعد الشمراني Library - نسخة (2).rar تحياتي

الزر معاينة التقرير ( فردي ) قبل الطباعة يعمل بدون مشاكل برجاء التوضيح اكثر عن مكان المشكلة بارك الله فيك تحياتي

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

تفضل اخي الكريم _______Library -.rar تحياتي

السلام عليكم يمكنك استخدام الكود التالي DoCmd.OpenReport "تقرير المصروفات", acViewPreview, , "Teacher = '" & Me.ZTeacher.Column(1) & "'" تحياتي

تفضبل اخي الكريم Private Sub Command41_Click() ' تفريغ مصدر النموذج الفرعي SourceObject Me.frm.SourceObject = "" ' اعلان عن متغيير عددي Dim FormCount As Integer Dim i As Integer 'سيكون المتغيير FormCount = عدد النماذج المفتوحة FormCount = Forms.Count ' عمل خلقة تكريرية For i = FormCount - 1 To 0 Step -1 ' استثناء نماذج محددة من الاغلاق وذلك بالشرط التالي ' اذا كان النموذح المفتوح غير النموذج frmHome login ونموذج If Forms(i).Name <> "frmHome" And Forms(i).Name <> "login" Then ' تنفيذ امر الاغلاق DoCmd.Close acForm, Forms(i).Name ' انهاء الشرط End If ' تشغيل الحلقة التكرارية Next i End Sub والله اعلم تحياتي

وعليكم السلام ورحمة الله وبركاته الحل الامثل لما ذكرت هو ان تكون قاعدة البيانات Sql Server وهناك شروحات كثيرة تفضل هذا موضوع لاستاذنا الفاضل @Elsayed Bn Gemy تحياتي

وعليكم السلام ورحمة الله وبركاته جرب استخدام دالة NZ كالتالي NZ(Text;0) وكما في مثالك اجمالي الدوام بالدقيقة: Nz(DateDiff("n";[وقت الدخول];[وقت الخروج]);0) ساعات العمل الفعلية: Nz([اجمالي الدوام بالدقيقة]/60;0) تحياتي

وعليكم السلام ورحمة الله وبركاته في السطر DoCmd.RunSQL "UPDATE Table SET tabl1.storemax = [Forms]![passtabl1]![storemax]-[Forms]![passtabl1]![too] WHERE (((tabl1.id)=[forms]![passtabl1]![id]));" لا يوجد جدول باسم Table والصحيح كالتالي DoCmd.RunSQL "UPDATE tabl1 SET tabl1.storemax = [Forms]![passtabl1]![storemax]-[Forms]![passtabl1]![too] WHERE (((tabl1.id)=[forms]![passtabl1]![id]));" بالنسبة للسطر التالي DoCmd.RunSQL "UPDATE Qurey SET Qurey1.storemin = [Forms]![passtabl1]![storymax]+[Forms]![passtabl1]![too] WHERE (((tabl1.id)=[forms]![passtabl1]![id]));" لا يوجد لديك استعلام باسم Qurey والصحيح Query1 ولكن لاحظت انك تعيد العملية مرة اخرى المرة الاولى في السطر الاول طرح ( - ) والمرة الاخرى في السطر الثاني جمع ( + ) فلم افهم السطر الثاني جيدا فبرجاء التوضح بخصوص السطر الثاني تحياتي

اخي الكريم جرب تغيير العلامة المائلة من / الى \ هكذا F:\fils\"&[BillNo]&".pdf او ارفق مثال لنفهم سوياً اين المشكلة تحياتي

السلام عليكم تفضل اخي الكريم Private Sub Command41_Click() Me.frm.SourceObject = "" Dim FormCount As Integer Dim i As Integer FormCount = Forms.Count For i = FormCount - 1 To 0 Step -1 If Forms(i).Name <> "frmHome" And Forms(i).Name <> "login" Then DoCmd.Close acForm, Forms(i).Name End If Next i End Sub تعديل_2.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم الكود التالي Private Sub Command4_Click() Dim Per_name As String Per_name = (" حكمت سليمان ") Per_name = TrimAll(Per_name, " ") MsgBox Per_name End Sub Function TrimAll(thisString As String, thisSeparator As String) As String Dim sepPosition As Integer, lastPosition As Integer Dim j As Integer, i As Integer, s As Integer, trimmed As String s = 1: j = 1: trimmed = "" Do sepPosition = InStr(j, thisString, thisSeparator) If sepPosition = 0 Then lastPosition = j j = sepPosition + 1 Else j = sepPosition + 1 trimmed = trimmed + Mid$(thisString, s, sepPosition - s) s = j End If Loop While j <> 1 TrimAll = trimmed & Mid$(thisString, lastPosition, 100) End Function تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم اغلاق جميع النماذج والنماذج الفرعية المفتوحة Private Sub Command41_Click() Me.FRM.SourceObject = "" Dim FormCount As Integer Dim i As Integer FormCount = Forms.Count For i = FormCount - 1 To 0 Step -1 If Forms(i).Name <> FormName Then DoCmd.Close acForm, Forms(i).Name End If Next i DoCmd.OpenForm "frmHome" End Sub تعديل.rar تحياتي

تفضل اخي الكريم Private Sub Command0_Click() If MsgBox("هل تريد اجراء نسخة احتياطية من البرنامج؟", _ vbQuestion + vbYesNo, _ "نسخة احتياطية") = vbYes Then On Error Resume Next Dim OldFile As String, DBwithEXT, DBwithoutEXT, NewFile As String, CopyMyDB Dim fs, cf, strFolder strFolder = CurrentProject.Path & "\Backup" Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(strFolder) = False Then Set cf = fs.CreateFolder(strFolder) End If OldFile = CurrentDb.Name StrNew = CurrentProject.Path & "\Backup" DBwithEXT = Dir(OldFile) DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 6) If [BKUP] = True Then NewFile = StrNew & "\" & DBwithoutEXT & "-" & Format(Date, "yyyy-mm-dd") & "-" & Format(Now(), "Hh-Nn-Ss-AMPM") & Right(DBwithEXT, 6) CopyMyDB = "cmd.exe /C copy " & """" & OldFile & """" & " " & """" & NewFile & """" Shell CopyMyDB, 0 Exit Sub End If End If Backup_2.rar تحياتي

سلمت يداك استاذنا الفاضل @Barna تحياتي

وعليكم السلام ورحمة الله وبركاته من وجهة نظري البسيطة لو وضعت كود لعمل نسخة احتياطية عند الاغلاق ومسار الحفظ هو google drive سيكون حل مناسب تحياتي

السلام عليكم جرب المرفق ListBox Test.rar تحياتي

بالاضافة الى ما تفضل به استاذنا الفاضل @أحمد الفلاحجى وله الشكر تفضل اخي الكريم استبدال الاحرف التي يوجد له مشابه كحرف ( ة ) و ( ه ) Private Sub t5_Exit(Cancel As Integer) Me.t5 = Replace([t5], "أ", "ا") Me.t5 = Replace([t5], "إ", "ا") Me.t5 = Replace([t5], "إ", "ا") Me.t5 = Replace([t5], "آ", "ا") Me.t5 = Replace([t5], "ة", "ه") Me.t5 = Replace([t5], "ي", "ى") Me.salah.Form.Filter = "ForSearch([TitleBook]) Like '*' & '" & t5 & "' & '*'" Me.salah.Form.FilterOn = True End Sub 1029.نموذج بحث.rar تحياتي

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

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

بالاضافة الى ما تفضل به الاخوة الكرام ولهم الشكر من فضلك اخي الكريم @حلبي جرب معي الكود التالي يعمل بطريقة افضل من الاول Option Compare Database Private Sub Command1_Click() ' الشهر الحالي Dim X1, X2 As String X1 = Format(DateSerial(Year(Date), Month(Date), 1), "mm/dd/yyyy") X2 = Format(DateSerial(Year(Date), Month(Date) + 1, 0), "mm/dd/yyyy") myCriteria = "([T1].[COURSEDATE] between #" & X1 & "# and #" & X2 & "#)" Me.TSUB.Form.Filter = myCriteria Me.TSUB.Form.FilterOn = True End Sub Private Sub Command2_Click() ' الشهر السابق Dim X3, X4 As String X3 = Format(DateSerial(Year(Date), Month(Date) - 1, 1), "mm/dd/yyyy") X4 = Format(DateSerial(Year(Date), Month(Date), 0), "mm/dd/yyyy") myCriteria = "([T1].[COURSEDATE] between #" & X3 & "# and #" & X4 & "#)" Me.TSUB.Form.Filter = myCriteria Me.TSUB.Form.FilterOn = True End Sub FILTER.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل يا غالي Option Compare Database Option Explicit Dim X1 As Boolean Private Sub GroupHeader0_Format(Cancel As Integer, FormatCount As Integer) If X1 Then Detail.BackColor = 16777199 Else Detail.BackColor = 14877777 End If X1 = Not (X1) End Sub UP-db1.mdb تحياتي

تفضل اخي الكريم PhotoC.rar تحياتي

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام الكود التالي Private Sub Form_BeforeUpdate(Cancel As Integer) On Error Resume Next DoCmd.SetWarnings False If MsgBox(" هل تريد حفظ التغييرات؟ ", vbYesNo, " تأكيد الحفظ") = vbNo Then Me.Undo End If DoCmd.SetWarnings True End Sub تحياتي

تفضل اخي الكريم تم تعديل كود الشهر السابق كالتالي Private Sub Command2_Click() ' الشهر السابق Dim x1, x2 As Date x1 = DateSerial(Year(Date), Month(Date) - 1, 1) x2 = DateSerial(Year(Date), Month(Date), 0) ' myCriteria = "[T1].[COURSEDATE] Between #" & x1 & "# And #" & x2 & "#" myCriteria = "[T1].[COURSEDATE] Between DateSerial(Year(Date()), Month(Date()) - 1, 1) And DateSerial(Year(Date()), Month(Date()), 0)" Me.TSUB.Form.Filter = myCriteria Me.TSUB.Form.FilterOn = True End Sub FILTER.rar تحياتي