jjafferr

غيري السطر rst!VisitNo = C + 1 الى rst!VisitNo = IIf(C = "NA", "", C + 1)

1و2. تمام بس اكتبي السطر التالي في النهاية Me.frm_WORKSCOPE.Requery جعفر

وعليكم السلام تفضلي Dim rst As DAO.Recordset Dim RC As Integer Dim C As Integer Set rst = CurrentDb.OpenRecordset("Select * From qry_workscope_utility") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount rst.MoveNext C = rst!VisitNo rst.MovePrevious rst.Edit rst!VisitNo = C + 1 rst.Update rst.Close: Set rst = Nothing جعفر

تفضل Dim a() as string x = "852 ,123, 456, 789, 741" 'بدل ان يكون عندنا سطر للمتغير 'x 'اعمله اعمدة للمتغير 'a 'Array 'بحيث يكون فصل كل كلمة بعد الفاصلة a=split(x,",") 'خلينا نشوف قيم المتغير 'a 'من اول سطر فيه ، وهو صفر ، الى اخر سطر فيه 'Lower Bound(a) to Upper Bound(a) for i=lbound(a) to ubound(a) if a(i)=789 then msgbox "found 789" end if next i جعفر

وعليكم السلام Dim a() as string x = "852 ,123, 456, 789, 741" a=split(x,",") for i=lbound(a) to ubound(a) if a(i)=789 then msgbox "found 789" end if next i جعفر

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

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

وعليكم السلام تفضل: لقياس سرعة تنفيذ المجموعة 1 ....كود t = timer ....كود t1 = timer - t ' الوقت بالثواني ....كود لقياس سرعة تنفيذ المجموعة 2 ....كود t = timer ....كود t2 = timer - t ' الوقت بالثواني ....كود . هكذا ، t1 و t2 و ... يعطوك وقت تنفيذ كل مجموعة ولكن اخذ اكثر من قراءة واحدة لكل مجموعة ، ثم اخذ المعدل. جعفر

اعتذر عن هذا الخطأ جرب المرفق جعفر 694.مثال على البرنامج 1.accdb.zip

وعليكم السلام اخي سلمان تفضل Private Sub cmd_ReSeq_Click() Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From TB_1 Where isNull(m_RegMin1)=False Order By No_Common") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount 'set all id2 to zero DoCmd.SetWarnings False DoCmd.RunSQL ("UPDATE TB_1 SET Id2 = 0") DoCmd.SetWarnings True For i = 1 To RC rst.Edit rst!id2 = i rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing MsgBox "Done" End Sub جعفر 695.sa.accdb.zip

وعليكم السلام اخي سلمان اولا احب ان اشكرك على جميل عرضك للسؤال ، بالشرح المفصّل والصور ، وبأسم النموذج والزر وووو والآن الى اسألتك 1. ازرار نموذج ورقة البيانات: من المعروف ان طريقة عرض ورقة البيانات لا تستطيع ان تجعل فيها ازرار ، ولكن مثل ما تفضّلت ، فيها ميزة التحكم بالاعمدة (الحقول) وتحريكها ، والتي لا توجد بالنموذج المستمر ، فإذا اردت ان تعمل كود لهذا النموذج ، فتستطيع ان تعمله بطرق اخرى غير الزر ، مثل حدث "النقر المزدوج" في حقل معين ، او كتابة رمز/رقم/حرف/كلمة في حقل وعمل الحدث على "بعد تحديث" الحقل ، الطريقة الاخرى اللي تستطيع ان تشغّل كود نموذج ورقة البيانات (في هذه الحالة سيكون النموذج نموذج فرعي) ، ولكن تعمل الزر في النموذج الرئيسي ، والذي سيستدعي كود نموذج ورقة البيانات الفرعي: في نموذج ورقة البيانات الفرعي ن_عروض_الاراضي_العام بدلا عن Private Sub ss_Click() اكتب Public Sub ss_Click() ومن اي نموذج/تقرير/وحدة نمطية في البرنامج ، نستطيع ان نناديها هكذا Call ن_عروض_الاراضي_العام.ss_Click . 2. تصدير النموذج بعد التصفية الى ملف وورد: انا عملت زر على النموذج الرئيسي "عروض - طباعة" ، ووضعت عليه هذا الكود: Private Sub ss_External_Click() 'Call ن_عروض_الاراضي_العام.ss_Click fltr = Replace(Me.ن_عروض_الاراضي_العام.Form.Filter, "[ن_عروض_الاراضي_العام].", "") fltr = Replace(fltr, "ن_عروض_الاراضي_العام.", "") DoCmd.OpenForm "ن_عروض_الاراضي_العام", acFormDS, , fltr, , acHidden DoCmd.OutputTo acOutputForm, "ن_عروض_الاراضي_العام", acFormatRTF, "c:\Temp\myDoc.rtf", True End Sub . اسمح لي ان اقترح عليك تغيير طريقة وضعك للنماذج الفرعية المتراكمة!! فاما ان تضعها عن طريق صفحات (وهو الاسهل) ولا يختلف كثيرا عن طريقة عملك ، ولكن سيكون لكل نموذج اسمه ، او تعمل كائن فارغ في النموذج الرئيسي (تعمل نموذج فرعي ، ثم تحذف اسم النموذج الفرعي من Source Object ، فيبقى كائن النموذج الفرعي فارغا) : . ثم عندما تريد ان تضع النموذج الفرعي ن_عروض_الاراضي_العام هناك ، تضع هذا الكود على الزر: Me.mySub.SourceObject = "ن_عروض_الاراضي_العام" . والميزة انه عندما تريد ان تنادي هذا النموذج الفرعي (او اي نموذج فرعي آخر) ، فلا تستعمل اسمه ، وانما تستعمل اسم mySub ، ويجعل النموذج الرئيسي يعمل بسرعة (لوجود نموذج فرعي واحد فقط فيه) ، وفي نفس الوقت نقل البيانات يكون اقل ، لأننا نتعامل مع نموذج فرعي واحد جعفر 694.مثال على البرنامج 1.accdb.zip

حياك الله اخوي ابو عبدالله جعفر

وعليكم السلام اخوي ابو عبدالله ايش رايك بهذه الطريقة ، اختيار اعضاء الفريق ، هو الذي يقرر التشكيل ، والكود يذكرك بالاعضاء المختارين ، كلما تختار الفريق: وهذا هو الكود: Private Sub List0_AfterUpdate() On Error GoTo err_List0_AfterUpdate List2.RowSource = "" List2.RowSource = "Select TypID,MemprName From MemprsTbl Where TypID=" & Me.List0.Column(0) 'everytime we click in List0, we look in Text4 items, 'every item in Text4, we select it in List2 'now show the items selected before, and exist Text4 now Dim x() As String 'split each line of Text4 based on vbCrLf x = Split(Nz(Me.Text4, ""), vbCrLf) 'loop through all the lines For i = LBound(x) To UBound(x) For j = 0 To List2.ListCount - 1 'now loop through List2 strSelected = Me.List2.Column(1, j) & ";" & Me.List2.Column(0, j) If x(i) = strSelected Then 'select List2 item if it is the same as Text4 Me.List2.Selected(j) = True End If Next j Next i Exit Sub err_List0_AfterUpdate: If Err.Number = 94 Or Err.Number = 9 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub Private Sub List2_Click() On Error GoTo err_List2_Click 'everytime we click in List2, we look in Text4 items, 'if there are Selected in List2, we leave it in Text4, 'if there are Not Selected in List2, we remove them from Text4 'loop through List2 items For i = 0 To List2.ListCount - 1 strSelected = Me.List2.Column(1, i) & ";" & Me.List2.Column(0, i) If Me.List2.Selected(i) Then 'is List2 item selected, add it to Text4 'but is it there already If InStr(Nz(Me.Text4, ""), strSelected) = 0 Then Me.Text4 = Me.Text4 & strSelected & vbCrLf End If Else 'Remove from Text4 Me.Text4 = Replace(Me.Text4, strSelected & vbCrLf, "") End If Next i Exit Sub err_List2_Click: If Err.Number = 94 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 693.TestList2.mdb.zip

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

وعليكم السلام اختي تفضلي: . . جعفر

حياك الله

عفوا الموضوع يحتاج توضيح شوي اكثر انا لما شفت كود الحفظ ، قلت: فالسؤال هو: هل البرنامج كله يعمل بطريقة الكود ، او ان هناك ربط لجداول قاعدة البيانات الخلفية ، يعني جداول قاعدة البيانات الخلفية مربوطة بالبرنامج الامامي؟ فإذا الجداول مربوطة ، فكل الكلام اعلاه لا ينطبق عليك ، وانسى هذه الفقرة اما اذا كان برنامجك كله بالكود ولا يوجد عندك ربط مع جداول البيانات الخلفية ، فتستطيع فتح نموذج واحد فقط ، مثل نموذج بدء التشغيل والمتصل بجدول في القاعده اللي على السيرفر ، وتقدر تخليه ظاهر او مخفي ، ولكن لا تغلقه إلا عند إغلاق البرنامج اذا كان هذا الكمبيوتر حقيقةً سيرفر ، فالمفروض يكون فيه شيء بإسم Raid ، اي مجموعة هاردسكات تعمل مع بعض كهارددسك واحد ، وبالتالي كُله تمام اما اذا كان كمبيوتر عادي فيه هارددسك واحد ، ولكن منصب عليه Windows Server ، فهذا لا هو سيرفر ، ونعم تحتاج الى هارددسك اضافي لبرنامجك ولكني شبه متأكد بأن الضغط والاصلاح راح يحل المشكلة ان شاء الله ، وبإنتظار البشارة منك جعفر

تفضل ضع بياناتك التي في ملف الاكسل في الجدول: M1_BKAWEST_Original ثم افتح النموذج Form1 ، وانقر على الزر Fix imported Excel وسترى النتيجة في الجدول: M1_BKAWEST وهذا هو الكود الذي يقوم بالعمل: Private Sub cmd_Fix_Click() On Error GoTo err_cmd_Fix_Click Dim rstS As DAO.Recordset Dim rstD As DAO.Recordset Set rstS = CurrentDb.OpenRecordset("Select * From M1_BKAWEST_Original") Set rstD = CurrentDb.OpenRecordset("Select * From M1_BKAWEST") rstS.MoveLast: rstS.MoveFirst RCs = rstS.RecordCount For i = 1 To RCs If rstS!Field1 = "محافظة" Then rstS.MoveNext Field8 = rstS!Field1 Field9 = rstS!Field2 Field10 = rstS!Field3 Field11 = rstS!Field4 Field12 = rstS!Field5 rstS.MoveNext rstS.MoveNext End If rstD.AddNew rstD![الشهرة] = Replace(rstS!Field1, Chr(34), "") rstD![الاسم] = Replace(rstS!Field2, Chr(34), "") rstD![اسم الاب] = Replace(rstS!Field3, Chr(34), "") rstD![اسم الام] = Replace(rstS!Field4, Chr(34), "") rstD![تاريخ الولادة] = Replace(rstS!Field5, Chr(34), "") rstD![رقم السجل] = Replace(rstS!Field6, Chr(34), "") rstD![المذهب] = Replace(rstS!Field7, Chr(34), "") rstD![محافظة] = Replace(Field8, Chr(34), "") rstD![قضاء] = Replace(Field9, Chr(34), "") rstD![البلدة او الحي] = Replace(Field10, Chr(34), "") rstD![طائفة اللائحة] = Replace(Field11, Chr(34), "") rstD![الجنس] = Replace(Field12, Chr(34), "") rstD.Update rstS.MoveNext Next i Exit_cmd_Fix_Click: rstS.Close: Set rstS = Nothing rstD.Close: Set rstD = Nothing MsgBox "Done" Exit Sub err_cmd_Fix_Click: If Err.Number = 3021 Then Resume Exit_cmd_Fix_Click ElseIf Err.Number = 94 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 691.tarek.accdb.zip

حياك الله

تفضل 688.1.لازام نطوره - Copy.mdb.zip

تم تعديل زري البحث في مرفقي الاخير

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

لا ، ولهذا السبب اعطاك اخي شفان جواب على الطاير جعفر

تفضل وهذا الكود الاول Private Sub أمر20_Click() On Error GoTo error_Capture تابع15.Requery Dim rst As DAO.Recordset 'إيرادات iField = "إيرادات" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='إيرادات'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Erad_From = rst![رقم السند] rst.MoveLast Me.Erad_To = rst![رقم السند] 'اجل iField = "اجل" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='اجل'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Aajel_From = rst![رقم السند] rst.MoveLast Me.Aajel_To = rst![رقم السند] 'مصاريف iField = "مصاريف" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='مصاريف'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Masareef_From = rst![رقم السند] rst.MoveLast Me.Masareef_To = rst![رقم السند] 'سداد iField = "سداد" mySQL = "Select [رقم السند]" mySQL = mySQL & " From السندات" mySQL = mySQL & " Where [نوع السند]='سداد'" mySQL = mySQL & " And التاريخ>=#" & Me.n1 & "#" mySQL = mySQL & " And التاريخ<=#" & Me.n2 & "#" mySQL = mySQL & " Order By [رقم السند]" Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst rc = rst.RecordCount Me.Sadad_From = rst![رقم السند] rst.MoveLast Me.Sadad_To = rst![رقم السند] MsgBox "لا توجد سندات من نوع" & vbCrLf & msg Exit_error_Capture: rst.close: Set rst = Nothing Exit Sub error_Capture: If Err.Number = 3021 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next ElseIf Err.Number = -2147352567 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_error_Capture End If End Sub وهذا كود قراءة النموذج الفرعي Private Sub cmd_Search2_Click() On Error GoTo error_Capture2 تابع15.Requery Dim rst As DAO.Recordset Dim rst2 As DAO.Recordset Set rst = Me.تابع15.Form.RecordsetClone 'إيرادات iField = "إيرادات" rst.Filter = "[نوع السند]='إيرادات'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Erad_From = rst2![رقم السند] rst2.MoveLast Me.Erad_To = rst2![رقم السند] 'اجل iField = "اجل" rst.Filter = "[نوع السند]='اجل'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Aajel_From = rst2![رقم السند] rst2.MoveLast Me.Aajel_To = rst2![رقم السند] 'مصاريف iField = "مصاريف" rst.Filter = "[نوع السند]='مصاريف'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Masareef_From = rst2![رقم السند] rst2.MoveLast Me.Masareef_To = rst2![رقم السند] 'سداد iField = "سداد" rst.Filter = "[نوع السند]='سداد'" rst.Sort = "[رقم السند]" Set rst2 = rst.OpenRecordset Me.Sadad_From = rst2![رقم السند] rst2.MoveLast Me.Sadad_To = rst2![رقم السند] MsgBox "لا توجد سندات من نوع" & vbCrLf & msg Exit_error_Capture2: rst.close: Set rst = Nothing rst2.close: Set rst2 = Nothing Exit Sub error_Capture2: If Err.Number = 3021 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next ElseIf Err.Number = -2147352567 Then If InStr(msg, iField) = 0 Then msg = msg & iField & vbCrLf End If Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description Resume Exit_error_Capture2 End If End Sub جعفر 688.1.لازام نطوره - Copy.mdb.zip