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

السلام عليكم ورحمة الله غير هذا السطر Range("e22").Value = C.Offset(0, -1) الى sheet2.Range("e22").Value = C.Offset(0, -1)

السلام عليكم ورحمة الله لعل هذا ما تقصده Book1.rar

السلام عليكم ورحمة الله جرب هذا الملف اختبار.xls

السلام عليكم ورحمة الله استخدم هذا الكود Sub DataDate() Dim ws As Worksheet, C As Range Dim LR As Long, i As Integer, x As Integer Dim Dt Set ws = Sheets("ADD") LR = ws.Range("B" & Rows.Count).End(xlUp).Row Dt = ws.Range("S2") For Each C In ws.Range("E2:P2") If C.Value = ws.Range("R2") Then x = C.Column End If Next i = 3 Do While i <= LR If ws.Cells(i, "C") <= Dt And ws.Cells(i, "D") >= Dt Then ws.Cells(i, "R") = ws.Cells(i, x) End If i = i + 1 Loop End Sub

السلام عليكم و رحمة الله اجعل الكود هكذا Private Sub TextBox1_Change() Dim LastRow As Long LastRow = Range("B1000").End(xlUp).Row If ActiveSheet.TextBox1.Text <> "" Then Range("$A$2:$C$" & LastRow).AutoFilter field:=1, Criteria1:=TextBox1.Value End If End Sub

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

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

السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 Or Target.Row < 4 Or Target.Value <> "حلب" Then Exit Sub Msg = MsgBox("هل تريد الاستمرار ؟", vbYesNo) If Msg = vbYes Then Exit Sub Else C.ClearContents End If End Sub

السلام عليكم و رحمة الله اكتب هذه المعادلة فى الخلية ("N2") بشرط الا تترك خلية فارغة فى العمود "L" بدءا من الصف الرابع =OFFSET($L$4;COUNTA($L:$L)-2;0)

السلام عليكم ورحمة الله ضع هذا الكود فى حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 3 Or Target.Row < 4 Then Exit Sub Dim C As Range, CList As Range Dim Msg As String Set CList = Range("C4:C" & Range("A" & Rows.Count).End(xlUp).Row) For Each C In CList If C.Value = "حلب" Then Msg = MsgBox("هل تريد الاستمرار ؟", vbYesNo) If Msg = vbYes Then Exit Sub Else C.ClearContents End If End If Next End Sub

السلام عليكم ورحمة الله بفرض ان تاريخ بداية العمل فى للخلية ("A1") اكتب فى الخلية التى يراد اظهار النتيجة فيها هذه المعادلة : =DATEDIF(A1;TODAY();"y")

السلام عليكم ورحمة الله ضع الكود فى موديول عادى و خصص له زر فى الشيت الذى تريده حتى لو كانت اكتر من شيت فلكل شيت زر مخصص له

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

السلام عليكم ورحمة الله بارك الله فيكم احبتى و شكرا على مروركم العطر و الحمد لله على تمام الامر

السلام عليكم ورحمة الله تفضل تكت التليفون والعنوان.xls

السلام عليكم ورحمة اله استخدم هذا الكود Sub DelRows() Dim x As Integer, i As Long, y As Long y = Sheet1.Range("A" & Rows.Count).End(xlUp).Row For i = y To 2 Step -1 x = WorksheetFunction.Days360(Cells(i, "A"), Date) If x < 45 Then Cells(i, "A").EntireRow.Delete End If Next End Sub

السلام عليكم ورحمة الله شكرا لك اخى الكريم على لدعمك المستمر و الله ولى التوفيق

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

السلام عليكم ورحمة الله استخدم الاكواد الآتية و الغى كل الاكواد الموجودة لديك Private Sub UserForm_Activate() Dim C As Range, Coll As New Collection On Error Resume Next For Each C In Sheets("sheet1").[A2:A5000] Coll.Add C.Value, C.Value Next C On Error GoTo 0 For Each Item In Coll Me.ComboBox1.AddItem Item Next Item End Sub Private Sub ComboBox2_Change() ComboBox3.Clear Dim C As Range For Each C In Sheets("sheet1").[B2:B5000] If Me.ComboBox2.Value <> "" Then If Me.ComboBox2.Value = C.Value And C.Count = 1 Then s = s + 1 ReDim temp(s, 1) temp(s, 1) = C.Offset(0, 1) Me.ComboBox3.AddItem temp(s, 1) End If End If Next End Sub Private Sub ComboBox1_Change() ComboBox2.Clear Dim C As Range For Each C In Sheets("sheet1").[A2:A5000] If Me.ComboBox1.Value <> "" Then If Me.ComboBox1.Value = C.Value Then p = p + 1 ReDim arr(p, 1) arr(p, 1) = C.Offset(0, 1) Me.ComboBox2.AddItem arr(p, 1) End If End If Next End Sub

السلام عليكم ورحمة الله استخدم هذا الكود بديلا للكود الموجود داخل الفورم Private Sub UserForm_Activate() Dim c As Range, Coll As New Collection On Error Resume Next For Each c In Sheets("sheet1").[A2:A5000] Coll.Add c.Value, c.Value Next c On Error GoTo 0 For Each Item In Coll Me.ComboBox1.AddItem Item Next Item If Me.ComboBox1.Value <> "" Then p = p + 1 ReDim arr(p, 1) arr(p, 1) = c.Offset(0, 1) Me.ComboBox2.AddItem arr(p, 1) End If If Me.ComboBox2.Value <> "" Then s = s + 1 ReDim temp(s, 1) temp(s, 1) = c.Offset(0, 2) Me.ComboBox2.AddItem temp(s, 1) End If End Sub

السلام عليكم ورحمة الله ضع هذا الكود فى حدث الصفحة Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column <> 3 Or Target.Row < 7 Then Exit Sub Dim C As Range For Each C In Range("C7:C" & Range("C" & Rows.Count).End(xlUp).Row) If C.Value = "سدد" Then C.Offset(0, 1).Resize(1, 12).Value = "0" C.Offset(0, 13).Resize(1, 3).Value = "لا" End If Next End Sub

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

السلام عليكم ورحمة الله اخى الكريم اليك ملف الصف الثانى كما وعدتك يؤسفنى انه يضم شعبتين فقط هما ( شعبة الادارة و شعبة القانون ) لانه مصمم حسب نظام المدرسة عندنا ان شاء الله تتحسن الظروف و استطيع اضافة الشعبتين الاخرتين اليك ملف الصف الثانى ثانية.xlsm

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

السلام عليكم ورحمة الله تفضل لا تنسى وضع زر خروج لليوزر فورم حتى لا تضطر لاغلاق الملف بأكمله Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare PtrSafe Function SetWindowPos Lib "user32.dll" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function BringWindowToTop Lib "user32.dll" (ByVal hWnd As Long) As Long Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Const WS_SYSMENU = &H80000 Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2 Dim hWnd As Long Private Sub UserForm_Initialize() On Error Resume Next Dim lngWindow As Long, lFrmHdl As Long lFrmHdl = FindWindow(vbNullString, Me.Caption) lngWindow = GetWindowLong(lFrmHdl, GWL_STYLE) lngWindow = lngWindow And (Not WS_CAPTION) Call SetWindowLong(lFrmHdl, GWL_STYLE, lngWindow) Call DrawMenuBar(lFrmHdl) End Sub