ناصر سعيد

جزاك الله كل خير وبارك فيك استاذ زيزو

ربنا يبارك فيك يارب استاذ زيزو

الرصد يتم فى شيت الشعبة مباشرة ... واين هذا الشيت من فضلك ؟

المحترم استاذ زيزو لماذا لم تجبني على هذا السؤال ؟ اين تتم عمليه الرصد في البرنامج ؟

كود ولا اروع ... ربنا يبارك فيك

يحفظك الخالق استاذ بن عليه

هل يمكن يا اخ وليد ان تضع الملف الاخير وهو يعمل جيدا حتى يكون مساهمه لاخوانك الذين يبتغون مثل هذا العمل

المحترم الاستاذ سليم مامعنى هذا الرمز r% ولم علامه النسبه المئويه ؟

ربنا يحفظك ويصونك استاذ سليم حل ولا اروع ========= وجزاكم الله من الخير اكثر

جزاك الله خيرا ابجث عن هذه الجمله الخاصه بالشرط التاني في الكود Order2:=xlAscending ثم ضع بدل هذه الكلمه الرقم 2 xlAscending ادعو الله ان يكون ذلك هو المطلوب =========== ويمكنك التغيير في ترتيب الشروط بالطريقه التي تريدها بنفس الفكره وان لم تفهمها جيدا ابلغني لعل الله يرزقني بطريقه اسهل في التوصيل

تفضل اخي الكريم ادعو الله ان يكون هو المطلوب الفرز بثلاث شروط1.rar =============== Sub فرز_بتلات_شروط() ' ' Range("B6:Z1000").Select Selection.Sort Key1:=Range("L6"), Order1:=xlAscending, _ Key2:=Range("F6"), Order2:=xlAscending, _ Key3:=Range("C6"), Order3:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _ xlSortNormal Range("A6").Select End Sub

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

انت فين ياغالي بارك الله لك

محتاج التعديل عليه ليعمل على كل الصفوف Sub a() Dim st As Date Dim ed As Date Dim st_y As Integer Dim st_m As Integer Dim st_d As Integer Dim ed_y As Integer Dim ed_m As Integer Dim ed_d As Integer Dim y As Integer Dim m As Integer Dim d As Integer '------------------------------------------ st = Range("b2") ed = Range("c1") st_y = Year(st) st_m = Month(st) st_d = Day(st) ed_y = Year(ed) ed_m = Month(ed) ed_d = Day(ed) If ed_d >= st_d Then d = ed_d - st_d Else d = 30 + (ed_d - st_d) ed_m = ed_m - 1 End If If ed_m >= st_m Then m = ed_m - st_m Else m = 12 + (ed_m - st_m) ed_y = ed_y - 1 End If If ed_y < st_y Then MsgBox "date error": GoTo theend y = ed_y - st_y If d = 30 Then d = 0: m = m + 1 If m = 12 Then m = 0: y = y + 1 ActiveSheet.Range("D2") = y ActiveSheet.Range("E2") = m ActiveSheet.Range("F2") = d theend: End Sub جزاكم الله خيرا

جزاك الله خيرا وبارك فيك نرجو مزيد من مشاركاتك الطيبه

اثراء للموضوع الذي فتحه المحترم الاستاذ علي المصري Sub SaveAsPDF1() '======= Dim FSO As Object Dim S(1) As String Dim sNewFilePath As String Dim Row As Long ActiveSheet.Select Set FSO = CreateObject("Scripting.FileSystemObject") S(0) = ThisWorkbook.FullName If FSO.FileExists(S(0)) Then S(1) = FSO.GetExtensionName(S(0)) If S(1) <> "" Then S(1) = "." & S(1) sNewFilePath = ThisWorkbook.Path & "\نتيحة.pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNewFilePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True End If Else MsgBox "لم يتم حفظ الملف ..يوجد خطأ ما " End If ActiveSheet.Select Set FSO = Nothing M = MsgBox("تم التصدير خارج الشيت بإسم الله اكبر" & vbNewLine & "هذا موجود فى نفس مكان حفظ الملف", vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal + vbMsgBoxRight, "تم التصدير بصيغة pdf") End Sub بارك الله في صاحب هذا الكود .. وكل من كانت له بصمه في عمل الخير ================ Book1.rar

ضع ملفا به كودك يسهل للاخوه التعامل ... من فضلك

جزاك الله كل خير وبعد: لم اجد اي تاريخ في صوره البي دي اف ... اين توجد ؟

حفظك الله ورعاك استاذ بن عليه

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

بعد عده محاولات واسترشادا بحلكم استاذ بن عليه هل هذا التصرف يحتاج الى اضافه او حذف Sub KH_Sort() On Error Resume Next ''هذا الكود للعالم العلامه والبحر الفهامه عبد الله باقشير حفظه الله ''فرز بيانات الطلاب بمعيار الفصل الهدف من الكود Dim Add As Worksheet Dim MyShap As Shape Dim T As Integer Set Add = Sheets("رصد الترم الثانى") 'اسم صفحة فرز البيانات Set MyShap = Add.Shapes("Kh_Num") If MyShap.ControlFormat.Value = 1 Then T = 2 Else T = 1 Range("Data").Sort Range("EN7"), T End Sub مامعنى هذا السطر If MyShap.ControlFormat.Value = 1 Then T = 2 Else T = 1

الاخ الكريم بن عليه ربنا يحفظك ويصونك يارب بعد التجربه لاتعمل معي ... هل تم الفرز معك

لم ار صفحه المصدر التي ستاخذ منها بيانات الدرجات والاسم وغير ذلك ... فاين هذه الصفحه ؟

السلام عليكم ورحمة الله هذا ملف وبه كود بسيط للفرز بمعيار الفصل ولكنه لايعمل ... ارجو تضبيطه جزاكم الله خيرا Sub KH_Sort() Dim MyShap As Shape Dim T As Integer Set MyShap = Sheet4.Shapes("Kh_Num") If MyShap.ControlFormat.Value = 1 Then T = 2 Else T = 1 Range("data").Sort Range("AU12"), T End Sub كود لفرز الفصول 1.rar

أخي الغالي إن شاء الله سيسعدك الله .. وما علينا إلا أن نزرع أما الحصاد فبالتأكيد له أوانه .. افعل ما يجب عليك فعله فلربما يأتي اليوم الذي يحتاج إليه - ( أناس اليوم واناس آخرون ) - ما نقدمه .. فيتركوا لنا دعوة بظهر الغيب .. وما أجملها من دعوة من شخص لا تعرفه في زمان لا تعرفه في وقت وأجل لا تعرفه ، ومن يدري لعلها تخفف عنا تقبلوا وافر تقديري واحترامي الله يرحمك ويحسن اليك بحق الله ياستاذ عماد الحسامي