ياسر خليل أبو البراء

تفضل أخي الحبيب الملف التالي azx.rar

ارفق مثال للتوضيح اخي الحبيب

أخي في الله نصيحة لله برامج الكنترول من البرامج الضخمة التي تحتاج لعمل شاق ومضي ... وأنصح أن تتعامل أكثر ما تتعامل بالأكواد لأنه مع مرور الوقت واستخدام المعادلات وخصوصا معادلات الصفيف ستجد أن البرنامج يزداد حجمه ويثقل ويصعب التعامل معه.. أنا من مؤيدي البرمجة بالأكواد في البرامج الضخمة ... وأنا شخصيا من حوالي سنتين صممت برنامج للصف السادس الابتدائي طلب مني عملته تقريبا بنسبة 90 % بالأكواد والمعادلات بنسبة 10 % فقط وكان البرنامج قمة في الخفة رغم وجود بيانات كثيرة بالملف .. أرجو أن تكون فهمت مقصدي

لاختلاف التقويم الميلادي والتقويم الهجري ، الموضوع معقد نوعاً ما .. إن شاء الله تكون الدالة أدت الغرض ....

تفضل أخي Sub AddRedCircle() Dim c As Range Dim ws As Worksheet Dim Shp As Shape Set ws = ActiveSheet For Each c In Range("B2:E9") If c.Value <= 40 And c.Value >= 30 Then c.Select Set Shp = ws.Shapes.AddShape(msoShapeOval, c.Left, c.Top, c.Width, c.Height) With Shp .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) .Line.Weight = 2 End With End If Next c End Sub

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

بارك الله فيك أخي محمد الريفي تقبل تحياتي وتقديري

بارك الله فيك أخي سليم .. ملف رائع لو أمكن ممكن تعمل الملف بحيث تكون النتائج في ورقة منفصلة (معلش هتعبك)

أستاذي وأخي وحبيبي الخالدي والله لقد اشتقت إليك كثيرا .. إني أحبك في الله حلولك دائما أروع ما يكون بارك الله فيك

الأخت الفاضلة أم عبدالله/ بارك الله فيكى لقد كان فى ردك إجابة لما هو مطلوب ولكن يبقى جزء صغير وهو تعديل الكود ليشمل عدد من النطاقات كالتالى (E8:U8/E18:U18/E28:U28/E38:U38 وهكذا...) ليشمل أي عدد من النطاقات غير المتجاورة... وجزاكم الله خيرا وزادكم علماً.... تفضل أخي تعديل بسيط على الكود ليشمل المطلوب ، في السطر الأول اكتب ما تريد من النطاقات A1.rar

تفضل جزء من الحل azx.rar

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

إخواني تفضلو المطلوب بدون داعي للأكواد على الإطلاق كله بالمعادلات (هتعجب الأخ جمال عبد السميع ملك المعادلات) List Sheet Names In New Sheet.rar

كيف تريد تثبيتها مش فاهم لو تقصد بالكود ممكن بالسطر Range("A20").Value="منتدى أوفيسنا"

عفوا يا خلزمي

بفرض أن الرقم في الخلية A1 قم بوضع المعادلة التالية في الخلية B1 مثلاً =TRUNC(A1;1)

أخي الحبيب إذا كنت تنوي التعامل مع الأكواد فقم بإلغاء دمج الخلايا واستبدل هذا الدمج بالتوسيط خلال مجموعو خلايا عن طريق تحديد مجموعة الخلايا التي تريد توسيط النص بها ثم كليك يمين وتنسيق خلايا ثم التبويب Alignment ثم من القائمة المنسدلة الأولى اختر Center Across Seelction.

تفضل أخي الحبيب معادلة يمكن استخدامها بعد استخراج أسماء أوراق العمل Sheets Index.rar

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

التكرار بيكون على أساس أي عمود وضح أكثر

يرجى إرفاق نموذج لأي صفحة من الصفحات للعمل عليها

طيب ما كدا كويس كان 35 ميجا وأصبح 5 ميجا دا إنجاز

تفضل أخي جزء من المطلوب List Sheet Names In New Sheet.rar

الأخ الفاضل ارفق ملف للعمل عليه

جرب التالي .. قم بالتجربة لأني لم أجربه Private Sub ShockwaveFlash1_OnReadyStateChange(ByVal newState As Long) End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Dim rg As Range ActiveSheet.Unprotect "" If Not Intersect(Target, Range("h10")) Is Nothing Then Range("C18:C2014").ClearFormats For Each x In Range("C18:C2014") If x.Value = [h10] Then If rg Is Nothing Then Set rg = x Else Set rg = Union(rg, x) End If End If Next If rg Is Nothing Then Exit Sub rg.Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 10092441 End With End If If Not Intersect(Target, Range("C18:C2014")) Is Nothing Then Select Case Target Case 1 Target = "اولي ابتدائي" Case 2 Target = "ثانية ابتدائي" Case 3 Target = "ثالثة ابتدائي" Case 4 Target = "الصف الرابع" Case 5 Target = "الصف الخامس" Case 6 Target = "الصف السادس" Case 7 Target = "الصف السابع" Case 8 Target = "الصف الثامن" Case 9 Target = "الصف التاسع" End Select End If If Not Intersect(Target, Range("d18:d2014")) Is Nothing Then On Error Resume Next Select Case Target Case "ك" Target = "ذكر" Case "ن" Target = "انثى" End Select End If If Target.Column = 4 Or Target.Column > 8 Then GoTo 1 LR = Cells(Rows.Count, 2).End(xlUp).Row If Range("B" & LR) = "" Or Range("C" & LR) = "" Or Range("d" & LR) = "" _ Or Range("e" & LR) = "" Then GoTo 1 Range("b18:e" & LR).Select Selection.Sort Key1:=Range("b18"), Order1:=xlAscending, Header:=xlNo, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal ''''''''''''''''''''''''''''''''''''''''''''''' With Range("b20:b" & LR + 3) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Size = 18 .Font.Bold = True End With '''''''''''''''''''''''''''''''''''''''''''' With Range("b20:b" & LR + 3) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .Font.Size = 18 .Font.Bold = True End With Range("b" & LR + 5).Select 1: ActiveSheet.Protect "" Application.ScreenUpdating = True End Sub