ابراهيم الحداد

السلام عليكم ورحمة الله استخدم المعادلة التالية =IF(AND(C3>=32;C3<=34);32;IF(AND(C3>=35;C3<=50);35;IF(AND(C3>=51;C3<=60);40;"")))

السلام عليكم ورحمة الله تم اصلاح الكود كما يلى Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$9" Then Dim N As Variant Dim f As String Application.ScreenUpdating = False N = Range("F9") With N On Error Resume Next f = ThisWorkbook.Path & "\" & "الصور" Sheets("ورقة1").Label1.Picture = LoadPicture(f & "\" & "noimage" & ".jpg") Sheets("ورقة1").Label1.Picture = LoadPicture(f & "\" & Target & ".jpg") End With Call INDEXING End If Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله اخى اقصى ما استطعت الوصول اليه هو جلب القيم المطلوبة دون التقيد باى نطاق و لكن عيبه الوحيد ان الكود التالى سوف يتجاهل النطاقات الخالية تماما و لا اعلم ان كان سيروق لك هذا ام لا اليك الكود : Sub LastValues() Dim C As Range, i As Long, x As Integer For Each C In Range("C7:C100") If IsEmpty(C) Then i = C.Row - 1 x = Cells(i, 3) If x > 0 Then p = p + 1 Cells(7, p + 12) = x End If End If Next End Sub

السلام عليكم ورحمة الله لمعرقة النطاقات الخالية و تحقيق المطلوب فى نفس الوقت اعتقد من الافضل استخدام الكود التالى Sub LastValue() Dim i As Integer, j As Integer Dim x As Integer, y As Integer Range("G9:J9").ClearContents x = 7 i = 7 j = 13 Do While i <= 28 Do While j <= 34 y = WorksheetFunction.Max(Range(Cells(i, 3), Cells(j, 3))) If y > 0 Then Cells(9, x).Value = y Else Cells(9, x).Value = 0 End If x = x + 1 i = i + 7 j = j + 7 Loop Loop End Sub

السلام عليكم ورحمة الله بارك الله فيك على هذا الدعاء الطيب جعل الله لك نصيبا منه تم اصلاح الخطأ اليك الملف بعد التعديل عمل كارنية لكل طالب.rar

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

السلام عليكم ورحمة الله تفضل اخى الكريم الصالة.rar

السلام عليكم ورحمة الله تفضل يمكنك اختيار الاسماء من القائمة المنسدلة بورقة البيان و الكود سيعمل وحدة بيان حالة.xls

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

السلام عليكم ورحمة الله استخدم هذا الكود Sub SelCase() For i = 7 To 1000 If Not IsNumeric(Cells(i, "EU")) Then Cells(i, "DS") = Cells(i, "EU") ElseIf Cells(i, "FO") = 0 Then Cells(i, "DS") = "ناجح" ElseIf Cells(i, "FO") <= 2 Then Cells(i, "DS") = "دور ثان" Else Cells(i, "DS") = "راسب" End If Next End Sub

السلام عليكم ورحمة الله استخدم الكود التالى Sub DistGroups() Dim ws As Worksheet, LR As Long Dim i As Integer, j As Integer Dim n As Integer, x As Integer, y As Integer Dim p As Integer, s As Integer Set ws = Sheets("ورقة1") Application.ScreenUpdating = False Range("F2:I" & Range("F" & Rows.Count).End(xlUp).Row + 1).ClearContents LR = ws.Range("B" & Rows.Count).End(xlUp).Row x = WorksheetFunction.CountA(ws.Range("B2:B" & LR)) n = ws.Range("D2").Value y = Int(x / n) z = x Mod n If z > 0 Then n = n + 1 Else n = n End If p = 2 Do While p <= LR For i = 1 To n For j = 1 To y s = j + ((i - 1) * y) + 1 If p = s Then ws.Cells(j + 1, i + 5) = ws.Cells(p, 2) End If Next Next p = p + 1 Loop Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله استخدم هذا الكود Sub UnhideSheets() Dim Sh As Worksheet For Each Sh In Worksheets Sh.Visible = xlSheetVisible Next End Sub

السلام عليكم ورحمة الله استخدم المعادلة التالية =SUMPRODUCT(D6:D40;(E6:E40)-1)

السلام عليكم و رحمة الله احبتى فى الله اخجلتم تواضعى بردودكم ودعاؤكم لى جعلنى الله دائما عند حسن ظنكم

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

السلام عليكم ورحمة الله ضع الكود الاول فى موديول عادى Sub test() Dim sp As Shape Dim SN As String, SR As String SR = Sheet2.Range("B2").Text For Each sp In Sheet2.Shapes If sp.AutoShapeType = msoShapeHeart Then SN = sp.TextFrame.Characters.Text sp.Visible = False If SN Like "*" & SR & "*" Then sp.Visible = True Else sp.Visible = False End If End If 'Exit For Next End Sub وضع الكود الاخر فى حدث الورقة 2 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$B$2" Then Exit Sub Call test End Sub

السلام عليكم ورحمة الله استخدم الكود التالى بعد وضعه فى حدث ThisWorkBook دبل كليك على الخلية A1 فى كل مرة Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) If Target.Address <> "$A$1" Then Exit Sub On Error GoTo 1: For i = 1 To Sheets.Count If ActiveSheet.CodeName = Sheets(i).CodeName Then Sheets(i + 1).Activate Exit For End If Next 1: Exit Sub End Sub

السلام عليكم ورحمة الله استخدم هذا الكود لاظهار اليوزرقورم بدلا من الكود الموجود لديك واذا لزم الامر غير اسم اليوزر فورم فى الكود الجديد Sub ShowUserF() UserForm1.Show vbModeless End Sub

السلام عليكم ورحمة الله اجعل هذا السطر هكذا Sheets("سجل الصادر").Cells(EndRow + 1, 1).Value = EndRow - 1

السلام عليكم ورحمة الله الف الف مبروك عن جدارة و استحقاق

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

السلام عليكم ورحمة الله يجب وضع اسماء الصور فى العمود "B" بجوار الارقام اليك الملف المعلومات المدنية.rar

السلام عليكم ورحمة الله جرب هذا الجدول T_Table.xlsm

السلام عليكم ورحمة الله و يمكنك ايضا ان تجرب هذا الملف ربما يفيدك توزيع رغبات2.xlsm

السلام عليكم ورحمة الله ربما يفيدك هذا الملف جدول صباحى.xlsm