Ali Mohamed Ali

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

تفضل استاذى احتساب نهايات الخدمة-3.xlsx

وعليكم السلام اخى الكريم وكل عام وانتم بخير ورمضان مبارك تفضل لك ما طلبت تحيل_النتيجة_تيرم_ثان_ 2).rar

من فضلك وضح ما تريد على ملف بارك الله فيك وكل عام وانتم بخير

أخى الكريم اكتب ووضح على الملف النتائج المطلوب استخراجها والحصول عليها فالموضوع مازال مبهم

تفضل اخى الكريم احتساب نهايات الخدمة-2.xlsx

بارك الله فيك استاذ سليم دائما تعين المحتاج الى مساعدتك جزاك الله كل خير وجعله الله فى ميزان حسناتك-معادلة رائعة,أحسنت وأكيد هو ده المطلوب

تفضل هذا الكود Sub Macro5() Range("A1:P600").Select 'Criteria1:="<>" Columns("A:P").Select Range("A1").Activate Selection.PrintOut Copies:=1, Preview:=True, Collate:=True End Sub

تفضل اخى الكريم دالة لجلب التعليقات Comment من خلية الى خلية أخرى.xlsm

السلام عليكم استاذ طيب ممكن توضح طلبك بشرح أكثر فسؤالك به غموض وغير واضح بمعنى ما هو مقياس القيم التى تضاف فى عمود النقاط هل هى عندما تكون المكافأة 0.5 تضيف لعمود النقاط 1 ,بمعنى ان الإضافة تكون ضعف قيمة المكافأة ؟ ولو المكافأة تزيد او تقل عن 0.5 ما القيمة المطلوب اضافتها فى حالة الزيادة او فى حالة النقص ؟ من فضلك أفيدنى فى هذا الموضوع حتى يتم حل مشكلتك على اكمل وجه-وعذرا على الإطالة كل عام وانتم بخير وجزاك الله كل خير

بارك الله فيك -أحسنت

يمكنك استخدام هذا الكود Sub printter() Dim myrange Dim Rng, cell As Range Set myrange = Range("A600").End(xlUp) Set Rng = Range("A1:" & myrange.Address) For Each cell In Rng If cell = "" Then myrange = cell.Address MsgBox cell.Address ActiveSheet.PageSetup.PrintArea = "$A$1:P" & cell.Row ActiveSheet.PrintOut Exit Sub End If Next End Sub

تفضل اخى طلبك فى هذا الرابط

أهلا وسهلا بك اخ كريم فى منتدانا الكريم وكل عام وانتم بخير ورمضان مبارك من الأفضل ومن قواعد المنتدى تقوم انت بنفسك بعمل الملف واذا تعثرت فى اى جزء فتقوم برفعه الى المنتدى وسوف تلقى المساعدة ان شاء الله ولكنى وجدت هذا الملف عندى لعله يفيدك بارك الله فيك Reservation 2003.rar

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

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

هناك شرح داخلى لكود وضع الدوائر يمكنك تغيير واختيار العمدة التى تريد وضع الدوائر بها وهذا هو الكود مع شرح بسيط له Option Explicit Option Base 1 Sub DrawRedCircles() Dim myArray As Variant Dim Rng As Range Dim Cel As Range Dim Cell As Range Dim L As Long Dim T As Long Dim W As Long Dim H As Long Dim X As Long Dim rRow As Long Dim startRow As Long 'مصفوفة بأسماء الأعمدة المراد وضع دوائر حمراء بها myArray = Array("Q", "U", "Z", "AD", "AI", "AM", "AS", "AT", "AU", "AY", "BE", "BF", "BG", "BK", "BN", "BQ", "BR", "BW", "CA", "CG", "CH", "CI", "CM", "CR", "CV") 'رقم الصف الذى يحتوى على الدرجات النهائية الصغرى rRow = 9 'صف البداية أى أول صف به درجات الطلاب startRow = 10 Application.ScreenUpdating = False Call RemoveCircles With Sheets("Sheet1") For X = LBound(myArray) To UBound(myArray) Set Cel = .Range(myArray(X) & rRow) Set Rng = .Range(myArray(X) & startRow, .Range(myArray(X) & startRow).End(xlDown)) For Each Cell In Rng If Cell.Value < Cel Or Cell.Value = "Û" Then L = Cell.Left: T = Cell.Top W = Cell.Width: H = Cell.Height With .Shapes.AddShape(msoShapeOval, L, T, W, H) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.Transparency = 0 .Line.Weight = 1.5 End With End If Next Cell Next X End With Application.ScreenUpdating = True End Sub

وهذا كود اخر لإثراء الموضوع -بعد اذن اخى أحمد -1استبدال التظليل بدوائر حمراء.xlsm

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

تفضل جرب هذا alma1-1(Recovered).xlsm

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

تفضل أخى الكريم 1-111.xls

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

تفضل اخى الكريم ‏‏الحضور والانصراف معدلة-1.xlsx

وعليكم السلام اخى الكريم لو ممكن رفع الملف مرة اخرى فهناك مشكلة فى تحميله -جزاك الله كل خير