نجوم المشاركات

تفضل 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 جعفر

او فقط في حدث تحميل التقرير اكتب Private Sub Report_Load() Me.Filter = "[saf] = 10 And [ksm] = 1" Me.FilterOn = True End Sub

السلام عليكم ورحمة الله محاولة في الملف باستعمال الدالة SUMPRODUCT حسب فهمي للمطلوب.. بن علية حاجي a.rar

ترقيم تلقائي يتجدد مع بداية كل سنة على النحو التالي 1300001 1300002 1300003 1400001 1400002 وهكذا ................. باعتبار الرقم 13 ، 14 هو السنة والترقيم لاشك سيكون تبعا للسنة الحالية Private Sub Form_BeforeInsert(Cancel As Integer) On Error Resume Next Dim xLast, xNext As Integer Dim prtyr, prtTxt As Integer prtyr = Right(DatePart("yyyy", Date), 2) prtTxt = Left(DMax("ID", "tbl1"), 2) xLast = DMax("ID", "tbl1", prtTxt = prtyr) If IsNull(xLast) Then xNext = 1 Else xNext = Val(Mid(xLast, 3, 5)) + 1 End If Me!ID = prtyr & Format(xNext, "00000") End Sub ترقيم تلقائي جديد كل سنة.rar

بسم الله الرحمن الرحيم الحمد لله الواحد القهار، العزيز الغفار، مكور الليل على النهار ، تذكرة لأولي القلوب والأبصار وتبصرة لذوي الألباب والاعتبار ، الذي أيقظ من خلقه من اصطفاه فزهدهم في هذه الدار، وشغلهم بمراقبته وإدامة الأفكار ، وملازمة الاتعاظ والادكار، ووفقهم للدؤوب في طاعته والتأهب لدار القرار، والحذر مما يسخطه ويوجب دار البوار، والمحافظة على ذلك مع تغاير الأحوال والأطوار. أحمده أبلغ حمد وأزكاه، وأشمله وأنماه. أما بعد: رأيت أن أقدم عملا خالصا لوجه الله الكريم لعل الله يتغمدنا برحمته ولذا رأيت أنا الفقير إلى الله المحمدي عبد السميع عبد الغني وهو عباره عن ملف رائع لاستخراج شهادات الطلاب وأوائل الطلبة وشهادات تقدير للأوائل ولا ننسى الدعاء لساحرالاكسيل ومهندسه العالم العلامة والبحر الفهامة بمشيئة الله عبد الله باقشير جزى الله كل من كانت له بصمة في هذا العمل أوائل الطلبه وشهادات3.rar ===================================== تفضل اخي الكريم وجزاكم الله خيرا أوائل الطلبه وشهادات3.rar

هذا مثال به مجموعة كبيرة من الدوال جمعتها من مشاركات الأخوة السابقة فى عدد من المواقع Punct_ALl.zip

وعليكم السلام اخي وضاح السؤال هو ، في اي نموذج ، في اي حقل ، هل السنة لها علاقة بالموضوع جعفر

المشكلة أنني لست خبيراً في التعامل مع الفورم ولا أدري ما المطلوب بالضبط في الفورم .. تهت في الفورم الخاص بك ما رأيك في أن تقوم بعمل ملف جديد به فورم بسيط به الأدوات المطلوبة فقط مع بعض البيانات ليكون أيسر لمن يريد تقديم المساعدة فكلما كان الملف بسيط ومحدد كلما كانت الأمور أوضح للجميع وأعتذر لعدم قدرتي على مساعدتك بالأمر ..إذ كيف لي أن أساعدك بشيء لا أدركه بعد !!

بالنسبة الى الخطأ ، اعملي هذا التغيير على السطر rst!VisitNo = IIf(IsNumeric(C), C + 1, "") والآن عندك كودين يشتغلون ، وانتي اختاري الكود اللي يريحك جعفر

بالنسبة للتغيير اللي انتي عملتيه ، استخدمي التعديل التالي ، وراح يشتغل الكود 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 If C = "NA" Then Else ' If IsNull(Form_frm_WORKSCOPE.VisitNo) Or Form_frm_WORKSCOPE.VisitNo = "" Then rst.Edit rst!VisitNo = C + 1 rst.Update Me.frm_WORKSCOPE.Requery 'End If End If rst.Close: Set rst = Nothing جعفر

غيري السطر 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 جعفر

السلام عليكم أخي محمود .. جرب الكود التالي عله يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) Dim a As Variant Dim i As Long Dim r As Long a = Range("A2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value For i = LBound(a, 1) To UBound(a, 1) If a(i, 2) <> "" Then r = r + 1: a(i, 1) = r Else r = 0: a(i, 1) = "" End If Next i Application.EnableEvents = False Range("A2").Resize(UBound(a, 1), UBound(a, 2)).Value = a Application.EnableEvents = True End Sub وإن كنت لا أحبذ الأكواد في حدث ورقة العمل إلا للضرورة ..

جرب هذا الكود Option Explicit Sub calcalate_last_minus_One() Dim k%, Final_Row%, x%, i%, m#, s# With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With k = Sheets.Count For x = 1 To k m = 0: s = 0 Final_Row = Sheets(x).Cells(Rows.Count, "J").End(3).Row For i = 4 To Final_Row If IsNumeric(Sheets(x).Range("j" & i)) And Sheets(x).Range("j" & i) <> 0 Then m = Range("j" & i).Value: s = s + m End If Next Sheets(x).Range("L2") = s - m Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub

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

وعليكم السلام 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 جعفر

تم حل الأشكالية بنجاح مع شكري لكم .....

اشكرك اخى وملعمى الكريم ياسر جارى انشاء موضوع جديد

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

أخي الكريم ضع الكود بين أقواس الكود ليظهر بشكل منضبط جرب التالي .. ولا يجوز تسمية أكثر من ورقة بنفس الاسم Sub Test() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("معاشات استثنائية ") ws.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = "كشف " & Format(Time, "hhmmss") ws.Activate ws.Range("F12:H36").ClearContents MsgBox "Done ...", 64 End Sub

كما قال استاذنا شفان الجانب العملي يعطيك الخبره اكثر والاخوان اخي ما يقصرو دوما وهم يساعدوننا في اى معلومه اسال وستجد الاجابه مع الأيام ستعرف الكثير تحياتي للموقع والقايمين والمشاركين لقد استفدت منهم الكثر ربنا يجزيه خير ويسعدهم تحياتي أبو زاهر

هذا اهم شيء 1 / اقرأ بعض كتابات على الاكسس لكي تعرف ما هو بصورة عامة 2 / الجانب العملي سيعطيك الخبرة اكثر من قراءة الكتاب .. اي اعمل ما تريد و شارك مع الموضوعات وان شاء الله بمرور الوقت ستكون كما تريد هذا رأي

جزاكم الله خيرا جميعا الحمد لله استخدمت =IFA=B,TRUE ) وبذلك اذا كان A=B يكتب TRUE واذا كان A لا يساوي B يكتب FALSE

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

اتفضل افتح التقریر فی وضع تصميم واعمل كما في الصورة اليك المرفق بعد تعديل Database1 (1).rar

وعليكم السلام اخي سلمان تفضل 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

جزاكم الله خيرا وزادكم فضلا وعلما وبركة فى العمر والمال والأهل تم

ا / ياسر شكرا لسرعة الرد و لكن دائما يعطى رسالة not found هل ممكن اكون انا بكتب المسار غلط انا كتبت المسار بالكامل فى الخلية h2 و شكرا

وعليكم السلام اخوي ابو عبدالله ايش رايك بهذه الطريقة ، اختيار اعضاء الفريق ، هو الذي يقرر التشكيل ، والكود يذكرك بالاعضاء المختارين ، كلما تختار الفريق: وهذا هو الكود: 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

أخي الكريم صلاح جرب الكود التالي ويمكن وضعه في حدث فتح المصنف .. أو كما ترغب فيما بعد Sub OpenClosedWBs() Dim wbk As Workbook Dim ws As Worksheet Dim strInput As String Dim i As Long Dim p As Long Dim lr As Long Application.ScreenUpdating = False On Error Resume Next Set ws = ThisWorkbook.Sheets("Sheet1") For i = 2 To ws.Cells(Rows.Count, "H").End(xlUp).Row p = InStrRev(ws.Range("H" & i), "\") + 1 strInput = Mid(ws.Range("H" & i), p) Set wbk = Workbooks(strInput) If wbk Is Nothing Then Set wbk = Workbooks.Open(Filename:=ws.Range("H" & i)) If wbk Is Nothing Then MsgBox ws.Range("H" & i) & " Not Found!", vbCritical Exit Sub End If End If With wbk.Sheets(1) Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Activate End With Set wbk = Nothing Next i On Error GoTo 0 Application.ScreenUpdating = True End Sub

اتفضل اليك هذا الكود Private Sub NO_2_BeforeUpdate(Cancel As Integer) Dim MyDcount As Integer Dim MyId As Integer MyId = DLookup("[ID]", "التحويلة", "[رقم التحويلة]=" & Me.NO_2) MyDcount = DCount("*", "التحويلة", "[رقم التحويلة]=" & Me.NO_2) If MyDcount > 0 Then MsgBox "ھذا الرقم محجوزة .. سيتم نقلك اليه" Me.Undo Me.RecordsetClone.FindFirst "[id] = " & MyId Me.Bookmark = Me.RecordsetClone.Bookmark End If End Sub انا عم استخدم اوفيس 2010 وما فيها مشكلة لا تتعصب .. اهتم بصحتك اليك المرفق بعد تعديل --دليل ارقام التحويلات2.rar

لا أدري ما المشكلة بالضبط لديك فالأمر غير واضخ تماماً .. عموماً حسب ما فهمت جرب الكود التالي عله يفي بالغرض (ولا داعي لاستخدام التحقق من الصحة في هذه الحالة) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Target.Row > 16 And Target.Column = 7 Then Dim lr As Long, x As Long, y As Variant y = Target.Value lr = Cells(Rows.Count, Target.Column).End(xlUp).Row Application.EnableEvents = False x = Application.WorksheetFunction.CountIf(Range("G17:G" & lr), y) If y < 1 Or y > 10 Or Not IsNumeric(y) Then MsgBox "Wrong Entry", vbExclamation: Target.Value = "": GoTo Skipper If x > 50 Or y < 1 Or y > 10 Then MsgBox "انتبه . الرقم " & Target.Value & " تجاوز العدد 50", vbExclamation: Target.Value = "" End If Skipper: Application.EnableEvents = True End Sub

انا اتمنى اولا يا استاذ @وائل أبو عبد الرحمن ان تترفق بى فظروف عملى لو تلاحظ تمنعنى من التواجد بصفة مستمرة ولو لاحظت انقطعت بالدخول في الفترة السابقة الى الموقع وللعلم سأنقطع مرة اخرى قأرجوا منكم العفو والسماح ولغلاوتك عندى بعد انتهائى من الافطار والصلاة يعلم الله لم اقوم من على الجهاز حتى اتمتت طلباتك بالتمام والكمال ولكن وقعت فى مشكلة صغيرة لم استطع تلوين نتيجة البحث مع التشكيل جرب المرفق الاتى ابحث بكلمة موت وجرب بعد كتابة كلمة البحث الضغط على الزر البحث فى كل الحقول ثم اختر من مربع التحرير والسرد الايات مرة ثم اختر من مربع التحرير والسرد الحديث وفى كل مرة لاحظ الفرق وفى كل مره اقتح التقرير ولاحظ الفرق بهذا ادين بكل الشكر لله سبحانه وتعالى الذى هدانى وما كنت لاهتدى لولا ان هدانى الله عزوجل سبحانك لا علم لنا الا ما علمتنا فيارب لك الحمد حمدا كثيرا طيبا طاهرا مباركا فيه يارب لك الحمد كما ينبغى لجلال وجهك ولعظيم سلطانك ثم ادين بعد ذلك بالفضل والشكر لكل اساتذتنا الافاضل الكرام الذين لم يبخلوا ولم يملوا جزاهم الله خيرا الجزاء واحسن اليهم كما احسنوا الينا اخص بالشكر الاستاذ الجليل @رمهان صاحب السبق الاول فى الية البحث بهذا الاسلوب الاكثر من الرائع اخص بالشكر الاستاذ الجليل @ابو خليلصاحب الاكواد الخاصة بازالة التشكيل اخص بالشكر الاستاذ الجليل @أ / محمد صالح التعديل على كود البحث اخص بالشكر الاستاذ الجليل @Gamal.Saad التعديل على كود البحث وهذا المرفق ناتج مجهود كل اساذتا الكرام وما قمت به فقط هو مزج هذه الافكار الاكثر من الرائعه للوصول بها الى تلك النتيجة المرجو الوصول اليها بناء على طلب اخونا الكريم @وائل أبو عبد الرحمن كل عام وانتم الى الله تعالى اقرب كل عام وانتم بكل الخير ان شاء الله اسأل الله تعالى لى ولكم ولكل المسلمين والمؤمنين الاحياء والاموات العفو والعافية والمغفرة دمتم بكل الخير احبكم فى الله ولوجه الله البحث بدون تشكيل-2.rar

جزيت خيرا ممكن الغاء حماية الواجهة

عليكم السلام الاساسات المطلوبة جدول واحد فقط معرف الطالب/أسم الطالب / رقم الجلوس / النتيجة / التقدير/ الدور / العام الدراسي بعد تعبئة هذا الجدول بالبيانات تستطيعون البحث واستخراج المطلوب البحث / عن طريق نموذج استخراج النتائج / في تقرير

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

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

دقيقة وسأرسلها لك فى رسالة خاصة

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

هذه المشاركة لأحد الزملاء بالمنتدى رفعته كما هو دون تغيير "طباعة الحقول الممتلئة فقط" طباعة الحقول الممتلئة فقط.rar