jjafferr

هذا لا يُسمى بحث بالمربعات الثلاث!! ولا اعرف ما الفائدة من هذا؟ رجاء تشرح اكثر ، علشان ممكن نعطيك افكار اخرى. جعفر

وعليكم السلام هل هذا الذي تريده؟ هذا كود "زر الحفظ وجديد" Private Sub أمر27_Click() If MsgBox("Click""yes""سيتم الحفظ عند الضغط علي نعم", vbYesNo, "هل انت متأكد من انك تريد الفظ وتسجيل وارد جديد") = vbYes Then 'Me.Command3.Enabled = True 'Me.serh = Null If Me.Dirty Then Me.Dirty = False Forms!Fail1!lst_Main.Requery With Forms!Fail1!fail2.Form.RecordsetClone .AddNew !Namefail = Me.Alaksam .Update End With DoCmd.GoToRecord , , acNewRec End If End Sub . ولكن قبل ان تعمل عليه ، ازحه عن النموذج Fail1 حتى ترى النتائج هناك جعفر 874.test.zip

هل هذا قصدك؟ 873.العيادة.accdb.zip

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

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

لا يمكن بالطريقة الحالية ، لأن الامر يأتيه من الجدول عندك طريقتين لعمل الذي تريده: 1. ان تجعل الحقول غير مضمنه (غير مرتبطه بحقول بالجدول) ، يعني عند الذهاب الى سجل ، تأتي بالسجل من الجدول برمجيا ، ثم تُدخل هذه القيم في حقول النموذج ، وعند التغيير/إضافة وقبل الخروج من السجل يجب حفظ البيانات برمجيا ، 2. ان تعمل حقل مزيف/مؤقت لجميع الحقول او للحقول التي تريد تعمل المطلوب عليها ، بالإضافة الى الحقل الاصلmyDate : مثل tDate يعني تاريخ مزيف/مؤقت ، غير مضمن ، نوعه نص ، عند تحميل السجل ، تقول برمجيا: me.tDate = me.MyDate وعند حفظ السجل تقول برمجيا: me.MyDate = me.tDate عندها ستظهر رسالة الخطأ على الحقل MyDate جعفر

اذن مشكلتك تحدث عندما تستعمل "اخفاء خلفية الاكسس" ، في هذه الحالة يجب ان يساعدنا احد الشباب الذين يستعملون اخفاء الاكسس مثل اخونا شفان و صالح @صالح حمادي@Shivan Rekany

وعليكم السلام استعمل الكود التالي علشان يعطيك صفر للحقول الفاضية : NZ = Null to Zero A: nz([abc],0) جعفر

ومن ايهم . شو هي المشكلة اصلا؟

وعليكم السلام هذه طريقة . و . و جعفر

وعليكم السلام جرب هاي الكود ، طبعا بعدما تغير اسماء الحقول Private Sub Form_Error(DataErr As Integer, Response As Integer) 'MsgBox DataErr & vbCrLf & Screen.ActiveControl.Name & vbCrLf & _ Screen.ActiveControl.ControlType & vbCrLf & Screen.ActiveControl.Format If DataErr = 2113 And Screen.ActiveControl.Name = "iDate" Then Response = acDataErrContinue MsgBox "Date" ElseIf DataErr = 2113 And Screen.ActiveControl.Name = "icode" Then Response = acDataErrContinue MsgBox "Code" End If End Sub جعفر

المعذرة تفضل Option Compare Database Dim strcriteria As String ' Private Sub dfgh_AfterUpdate() Call searchCriteria End Sub Private Sub Form_Load() Call searchCriteria End Sub Private Sub n1_AfterUpdate() Call searchCriteria End Sub Private Sub n2_AfterUpdate() Call searchCriteria End Sub Private Sub qwer_AfterUpdate() Call searchCriteria End Sub Function searchCriteria() Dim task As String strcriteria = "" If Not IsNull(Me.dfgh) Then strcriteria = strcriteria & " And " strcriteria = strcriteria & " [اسم المشتري] = '" & Me.dfgh & "' " End If If Not IsNull(Me.qwer) Then strcriteria = strcriteria & " And " strcriteria = strcriteria & " [نوع البيع] = '" & Me.qwer & "' " End If If Not IsNull(Me.n1) And Not IsNull(Me.n2) Then strcriteria = strcriteria & " And " strcriteria = strcriteria & "Format([تاريخ الفاتورة],'yyyymmdd') Between " & Format(Me.n1, "yyyymmdd") & " And " & Format(Me.n2, "yyyymmdd") End If If Left(strcriteria, 5) = " And " Then strcriteria = " Where " & Mid(strcriteria, 6) End If 'Debug.Print strcriteria task = "Select * from [راس الفاتورة]" & strcriteria Me.مساعد_تصفية_فواتير_البيع.Form.RecordSource = task Me.مساعد_تصفية_فواتير_البيع.Form.Requery End Function Private Sub اغلاق_Click() DoCmd.Close acForm, "تصفية فواتير البيع" DoCmd.OpenForm "المركزي", acNormal End Sub Private Sub أمر10_Click() Me.dfgh = Null Me.qwer = Null Me.n1 = Null Me.n2 = Null Call searchCriteria End Sub Private Sub أمر11_Click() strcriteria = Replace(strcriteria, " Where ", "") 'DoCmd.OpenReport "تصفية البيع", acViewPreview, , strcriteria DoCmd.OpenReport "تصفية البيع", acViewNormal, , strcriteria End Sub جعفر 870..accdb.zip

وعليكم السلام واهلا وسهلا بم في المنتدى تفضل: Option Compare Database Dim strcriteria As String ' Private Sub dfgh_AfterUpdate() Call searchCriteria strcriteria = "" End Sub Private Sub Form_Load() Call searchCriteria strcriteria = "" End Sub Private Sub n1_AfterUpdate() Call searchCriteria End Sub Private Sub n2_AfterUpdate() Call searchCriteria strcriteria = "" End Sub Private Sub qwer_AfterUpdate() Call searchCriteria strcriteria = "" End Sub Function searchCriteria() Dim task As String If Not IsNull(Me.dfgh) Then strcriteria = " And " strcriteria = strcriteria & " [اسم المشتري] = '" & Me.dfgh & "' " End If If Not IsNull(Me.qwer) Then strcriteria = strcriteria & " And " strcriteria = strcriteria & " [نوع البيع] = '" & Me.qwer & "' " End If If Not IsNull(Me.n1) And Not IsNull(Me.n2) Then strcriteria = strcriteria & " And " strcriteria = strcriteria & "Format([تاريخ الفاتورة],'yyyymmdd') Between " & Format(Me.n1, "yyyymmdd") & " And " & Format(Me.n2, "yyyymmdd") End If If Left(strcriteria, 5) = " And " Then strcriteria = " Where " & Mid(strcriteria, 6) End If 'Debug.Print strcriteria task = "Select * from [راس الفاتورة]" & strcriteria Me.مساعد_تصفية_فواتير_البيع.Form.RecordSource = task Me.مساعد_تصفية_فواتير_البيع.Form.Requery End Function Private Sub اغلاق_Click() DoCmd.Close acForm, "تصفية فواتير البيع" DoCmd.OpenForm "المركزي", acNormal End Sub Private Sub أمر10_Click() Me.dfgh = Null Me.qwer = Null Me.n1 = Null Me.n2 = Null Call searchCriteria End Sub Private Sub أمر11_Click() Call searchCriteria DoCmd.OpenReport "تصفية البيع", acViewNormal, , strcriteria strcriteria = "" End Sub جعفر 870.بيع.accdb.zip

وعليكم السلام الكود سيصبح Private Sub a_AfterUpdate() Call Compare_a_b End Sub Private Sub b_AfterUpdate() Call Compare_a_b End Sub Private Sub Compare_a_b() If Len(Me.a & "") <> 0 And Len(Me.b & "") <> 0 Then If Me.a > 2000 And Me.b < 5000 Then Me.c = 2 ElseIf Me.a > 5000 And Me.b < 10000 Then Me.c = 3 Else Me.c = "" End If Else Me.c = "" End If End Sub جعفر 867.11.mdb.zip

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

وعليكم السلام ولأنك ما اعطيتنا مثال ، فعملت جميع انواع الجمع جعفر 864.جمع تراكمي.mdb.zip

وعليكم السلام بالنسبة الى التقرير ، فإعدادات الاكسس تحتوي على مسافات (فراغات من اليمين واليسار) ، . وفي تصميم التقرير ، عرض التقرير يعتمد على حجم الورقة التي قمت بإختيارها ، وفي حالتك A4 ، ولكن الطابعة تحتاج ان تسحب الورقة من جميع الجهات (الاعلى والاسفل واليمين واليسار) عن طريق بكرات (وحجم هذه البكرات تختلف بإختلاف الطابعات) ، لذلك ، عند اختيارك الطابعة ، افتح خيارات الطباعة (كما هي في الصوره في الاسفل) ، واجعل المسافة = 0 ، ثم اخرج من التقرير بعد حفظه ، ثم ادخل في هذه الخيارات مرة اخرى ، وستجد المسافات الحقيقية لطابعتك ، والتي لا يمكن ان تقلل منها ، . عليه ، تصبح المساحة المتوفرة لك لوضع حقولك لطباعتها في صفحة واحدة = عرض الورقة (مثلا A4 = 8.27 بوصة) - المسافات التي تحتاجها الطابعة (اليمين + اليسار = 0.25 + 0.25 كما في حالتي في الصورة اعلاه) = 7.77 بوصة. اذا عملت هذا ، فالمساحة المتوفرة لك لكل تقاريرك على هذه الطابعة لن تتغير (حتى على اي كمبيوتر آخر). هذا معناه ان التقرير اصبح به خراب/عطب ، والافضل لك عمل/صنع التقرير من جديد ، فلا تعرف اي من كائناته فيها العطب. جعفر

الظاهر عندك شيء آخر في البرنامج يمنع هذا ، لذلك لازم ترفق لي البرنامج بالكامل اذا اردت النظر فيه ، ولكن مثل قلت انت ، مادام البرنامج اشتغل تمام ، فمافي داعي لكل هذا جعفر

وعليكم السلام اضف في المعيار: <> الاسم جعفر

وعليكم السلام تريد جمع تراكمي لأي: 1. اسم؟ او 2. حقل؟ اذا ممكن تعطينا مثال عن الجواب الذي تريده من برنامجك. جعفر

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

السلام عليكم اخوي ابو ياسين في الرابط التالي ، اخبرتك عن الطريقة الصحيحة في وضع الكود في مشاركات المنتدى ، وجعل الكود سهل القراءة ، فطريقتك هي (كما هو الحال في الكود الذي وضعته في مشاركتك اعلاه) : DoCmd.RunSQL "UPDATE حركات SET حركات.البيان = Format([Forms].[Search]![snddate],""""""دخل يوم """"dddd ""), حركات.[نوع السند] = "" دخـل"",.حركات = ""الخزينه"" " & vbCrLf & _"WHERE (((حركات.[تاريخ الحركة])=[Forms].[Search]![snddate]));" بينما لو اتبعت تعليماتي في الرابط: . لكان كودك هكذا: DoCmd.RunSQL "UPDATE حركات SET حركات.البيان = Format([Forms].[Search]![snddate],""""""دخل يوم """"dddd ""), حركات.[نوع السند] = "" دخـل"",.حركات = ""الخزينه"" " & vbCrLf & _ "WHERE (((حركات.[تاريخ الحركة])=[Forms].[Search]![snddate]));" . فأي الطريقتين ستستخدم في وضع الكود في مشاركتك التالية جعفر

وعليكم السلام إحترافياً ، الامر On Error Resume Next يجب استخدامه في حالات خاصة وضيقة جداً (طبعا حالتك كانت خاصه علشان تحصل على الجواب السريع) ، لأن الامر يوقف جميع رسائل الخطأ ، والتي بعضها ضروري لمعرفة ماهية الخطأ ، ومن ثم معالجته. قمت بالتعديل على الملف المرفق ، والذي يصطاد الخطأ (وفي حالتنا ، البرنامج اخبرنا بأن رقم الخطأ هو 53): Private Sub cmd_Remove3_Click() On Error GoTo err_cmd_Remove3_Click .... .... 'delete the temp cvs file Kill nFile_Name Exit_cmd_Remove3_Click: Exit Sub err_cmd_Remove3_Click: If Err.Number = 53 Then 'file not found Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . وتم تحديث الملف في المشاركة السابقة جعفر

اصلحت المرفق السابق

اها دقيقة الكود الجديد اصبح Private Sub cmd_Remove3_Click() On Error GoTo err_cmd_Remove3_Click Dim TextLine, File_Name, File_ext, Folder_Name, nFile_Name File_Name = Dir(Me.txtPath) 'the file name only File_ext = Mid(File_Name, InStrRev(File_Name, ".") + 1) 'the file extension Folder_Name = Replace(Me.txtPath, File_Name, "") 'the folder name 'a temp csv file to transfer to it the correct lines nFile_Name = Folder_Name & Mid(File_Name, 1, Len(File_Name) - Len(File_ext) - 1) & "_2." & File_ext 'open both Input and Output files Open Me.txtPath For Input As #1 Open nFile_Name For Output As #2 i = 0 Do While Not EOF(1) ' Loop until end of file. Line Input #1, TextLine ' Read line into variable. i = i + 1 'skip the 1st 3 lines, and write the rest If i >= 4 Then Print #2, TextLine End If Loop Close #1 Close #2 Kill Replace(Me.txtPath, ".csv", ".xls") 'now we have a csv file correctly saved, 'convert it to xls Dim objXLApp As Object Dim wBook As Object Set objXLApp = CreateObject("Excel.Application") Set wBook = objXLApp.Workbooks.Open(nFile_Name, Format:=6, Delimiter:=",") wBook.SaveAs Replace(Me.txtPath, ".csv", ".xls"), FileFormat:=xlExcel8 wBook.Close 'False objXLApp.Quit Set wBook = Nothing Set objXLApp = Nothing 'delete the temp cvs file Kill nFile_Name Exit_cmd_Remove3_Click: Exit Sub err_cmd_Remove3_Click: If Err.Number = 53 Then 'file not found Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 862.298.Remove_3_Lines_csv.mdb.zip