asdhamdey

Sub طباعة_صفحه() ' ' ActiveSheet.PageSetup.PrintArea = "$A$1:$N$41" ActiveWindow.SelectedSheets.PrintPreview End Sub تجميع الاكواد في مكان عاجبني .. ربنا يسعدكم _استخراج الأوائل. للمحترم ابو عبد الباري Sub mh1() Application.GoTo Reference:="mh" Selection.Sort Key1:=Range("q9"), Order1:=xlDescending, Key2:=Range( _ "t9"), Order2:=xlDescending, Key3:=Range("p9"), Order3:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _ xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _ DataOption3:=xlSortNormal Range("a1").Select End Sub _ استخراج الأوائل بالمواد. للمحترم ابو عبد الباري Sub printpreview1() 'كود معاينة طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).printpreview End Sub Sub print_2() 'كود طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).PrintOut End Sub

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

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

=IF((M3="");"";IF(OR(M3<MIN(رقم_الجلوس);$M$3>MAX(رقم_الجلوس));"";INDIRECT(ADDRESS(MATCH(M3;رقم_الجلوس;0)+6;COLUMN();5;;$X$1)))) اقتباس طيب لنفترض إن اسم الطالب كان في العمود رقم 9 مثلاً .. في الحالة دي هنزود كام عشان تظبط المعادلة (فكـــــــــــــــــــــر شوية) المعادلة في العمود رقم 4 والاسم موجود في العمود رقم 9 يبقا عشان نوصل لرقم العمود اللي فيه اسم الطالب هنزود 5 فتصبح الدالة بهذا الشكل COLUMN()+5 دا كان مجرد مثال عشان تعرف إزاي تجيب البيانات من أي عمود ---- السؤال ---- طيب لنفترض إن اسم الطالب كان في العمود رقم 2 مثلاً .. المعادلة في العمود رقم 6 والاسم موجود في العمود رقم 2 يبقا عشان نوصل لرقم العمود اللي فيه اسم الطالب هانعمل ايه

ربنا يجزيك الخير استاذ سليم

Sub mh1() Application.GoTo Reference:="mh" Selection.Sort Key1:=Range("q9"), Order1:=xlDescending, Key2:=Range( _ "t9"), Order2:=xlDescending, Key3:=Range("p9"), Order3:=xlAscending, _ Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _ xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _ DataOption3:=xlSortNormal Range("a1").Select End Sub ربنا يجزيك خيرا استاذ ابو عبد الباري هل يمكن الاتيان بالعشره الاوائل في المواد ايضا

اين المتغيرات التي ينبغي تغييرها لكي يعمل مع ملف اخر جزاكم الله خيرا

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long Const GWL_STYLE = -16 Const WS_CAPTION = &HC00000 Const WS_SYSMENU = &H80000 Private Sub hidesheet() For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1 Sheets(i).Visible = xlSheetVeryHidden Next End Sub Private Sub alll() For i = 1 To 5 Me.Controls("m" & i * 2).Visible = False Me.Controls("a" & i).Top = 444 Me.Controls("x" & i).Top = 444 Next i For i = 1 To 8 Me.Controls("c" & i).Top = 444 Next i m2.Top = 555 m4.Top = 555 m2.Visible = True m4.Visible = True z1.Top = 444 z2.Top = 444 End Sub Private Sub cha() Call alll Me.Height = 128 x1.Top = 68 x2.Top = 66 x3.Top = 88 x4.Top = 86 x5.Top = 78 End Sub Private Sub cha1() Call alll Me.Height = 113 z1.Top = 64 z2.Top = 86 End Sub Private Sub cha2() MsgBox " عذرا ... أنت لا تملك الصلاحية للدخول لهذه الصفحة ", 48, "BESSAFI" End Sub Private Sub pasn() If Sheets(n3).ProtectContents = True Then Sheets(n3).Unprotect Password:=Sheet1.Range("d5").Value Call hidesheet Sheets(n3).Visible = xlSheetVisible Sheets(n3).Select End Sub Private Sub pasy() If Sheets(n3).ProtectContents = False Then Sheets(n3).Protect Password:=Sheet1.Range("d5").Value Call hidesheet Sheets(n3).Visible = xlSheetVisible Sheets(n3).Select End Sub Private Sub a3_Click() Dim sht As Worksheet For Each sht In ActiveWorkbook.Worksheets If sht.Name = a2 Then MsgBox "عذراً ... يوجد صفحة سابقة بهذا الاسم ...يرجى ادخال اسم اخر ", 48, "hosami" a2 = "" Exit Sub End If Next sht Me.Height = 27 dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1 Worksheets.add After:=Worksheets(dd) Sheets(dd + 1).Name = a2.Value Sheet1.Cells(7, (dd * 2) + 4) = a2.Value Sheet1.Cells(8, (dd * 2) + 4) = a2.Value a2 = "" Sheet1.Select Sheet1.ScrollArea = "" Sheet1.Cells(10, (dd * 2) + 4).Select MsgBox "عذراً ... يجب عليك إدخال صلاحيات المستخدمين لهذه الصفحة ", 48, "hosami" End Sub Private Sub b4_Click() Me.Height = 27 End Sub Private Sub acess_set_Click() Me.Height = 27 If acess_set.ForeColor = -2147483634 Then Call hidesheet Sheet1.Select Sheet1.ScrollArea = "" With ActiveWindow .ScrollColumn = Range("a1").Column .ScrollRow = Range("a1").Row End With Else MsgBox "عذراً ... لا تملك الصلاحية لهذه العملية ", 48, "BESSAFI" End If End Sub Private Sub b1_Click() If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 16 Then MsgBox "عذراً ...لقد وصلت للحد الاقصى لاضافة الصفحات ", 48, "hosami" Exit Sub End If Call alll Me.Height = 62 For i = 1 To 3 Me.Controls("b" & i).ForeColor = 65535 Next i Me.Controls("b" & 1).ForeColor = 65280 a1.Top = 66 a2.Top = 65 a3.Top = 65 a4.Top = 81 Me.Height = 100 End Sub Private Sub b2_Click() If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 0 Then MsgBox "عذراً ...البرنامج لا يحتوي على صفحات ", 48, "hosami" Exit Sub End If Call alll For i = 1 To 4 Me.Controls("b" & i).ForeColor = 65535 Me.Controls("m" & i * 2 + 2).Visible = True Next i Me.Controls("b" & 2).ForeColor = 65280 m4.Top = 60 dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) Me.Height = (dd - 4) * 20 + 167 For i = 6 To 36 Step 2 Me.Controls("m" & i).Caption = Sheet1.Cells(7, i) Me.Controls("m" & i).BackColor = 12648447 Next i End Sub Private Sub b3_Click() If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 0 Then MsgBox "عذراً ...البرنامج لا يحتوي على صفحات ", 48, "hosami" Exit Sub End If Call alll For i = 1 To 3 Me.Controls("b" & i).ForeColor = 65535 Next i Me.Controls("b" & 3).ForeColor = 65280 m2.Top = 60 m6.Visible = True m8.Visible = True m10.Visible = True dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) Me.Height = (dd - 4) * 20 + 167 For i = 6 To 36 Step 2 Me.Controls("m" & i).Caption = Sheet1.Cells(7, i) Me.Controls("m" & i).BackColor = 12648384 Next i End Sub Private Sub Label50_Click() ThisWorkbook.Close savechanges:=False End Sub Private Sub Label51_Click() ActiveWorkbook.Save End Sub Private Sub Label52_Click() If Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) = 0 Then MsgBox "عذراً ...البرنامج لا يحتوي على صفحات ", 48, "hosami" Exit Sub End If Call alll For i = 3 To (Application.WorksheetFunction.CountA(Sheet1.Range("f8:hh8")) * 2) + 3 Sheet1.Cells(2, i + 2) = Application.WorksheetFunction.VLookup(Sheet1.Range("c1").Value, Sheet1.Range("c10:hh5000"), i, 0) Next i dd = Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) Me.Height = (dd - 4) * 20 + 167 For i = 1 To 4 Me.Controls("m" & i * 2 + 2).Visible = True Me.Controls("b" & i).Top = 555 Me.Controls("b" & i + 4).Top = 555 Next i For i = 3 To 7 Me.Controls("c" & i).Top = 55 Me.Controls("c" & i + 1).Top = 56 Next i Me.Controls("c" & 1).Top = 22 Me.Controls("c" & 2).Top = 30 Me.Controls("m" & 2).Visible = False Me.Controls("m" & 4).Visible = False Me.Controls("b" & 4).Top = 30 Me.Controls("b" & 4 + 4).Top = 48 For i = 6 To 36 Step 2 Me.Controls("m" & i).Caption = Sheet1.Cells(7, i) Me.Controls("m" & i).BackColor = 12632256 If Sheet1.Cells(2, i) = "Yes" Then Me.Controls("m" & i).BackColor = -2147483624 If Sheet1.Cells(2, i + 1) = "No" Then Me.Controls("m" & i).BackColor = 8421631 End If Next i End Sub Private Sub m6_Click() n2 = 6: n3 = 2 x2 = m6.Caption z1 = m6.Caption If m6.BackColor = 12648384 Then Call cha Exit Sub End If If m6.BackColor = 12648447 Then Call cha1 Exit Sub End If If m6.BackColor = 12632256 Then Call cha2 If m6.BackColor = -2147483624 Then Call pasn If m6.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m8_Click() n2 = 8: n3 = 3 x2 = m8.Caption z1 = m8.Caption If m8.BackColor = 12648384 Then Call cha Exit Sub End If If m8.BackColor = 12648447 Then Call cha1 Exit Sub End If If m8.BackColor = 12632256 Then Call cha2 If m8.BackColor = -2147483624 Then Call pasn If m8.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m10_Click() n2 = 10: n3 = 4 x2 = m10.Caption z1 = m10.Caption If m10.BackColor = 12648384 Then Call cha Exit Sub End If If m10.BackColor = 12648447 Then Call cha1 Exit Sub End If If m10.BackColor = 12632256 Then Call cha2 If m10.BackColor = -2147483624 Then Call pasn If m10.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m12_Click() n2 = 12: n3 = 5 x2 = m12.Caption z1 = m12.Caption If m12.BackColor = 12648384 Then Call cha Exit Sub End If If m12.BackColor = 12648447 Then Call cha1 Exit Sub End If If m12.BackColor = 12632256 Then Call cha2 If m12.BackColor = -2147483624 Then Call pasn If m12.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m14_Click() n2 = 14: n3 = 6 x2 = m14.Caption z1 = m14.Caption If m14.BackColor = 12648384 Then Call cha Exit Sub End If If m14.BackColor = 12648447 Then Call cha1 Exit Sub End If If m14.BackColor = 12632256 Then Call cha2 If m14.BackColor = -2147483624 Then Call pasn If m14.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m16_Click() n2 = 16: n3 = 7 x2 = m16.Caption z1 = m16.Caption If m16.BackColor = 12648384 Then Call cha Exit Sub End If If m16.BackColor = 12648447 Then Call cha1 Exit Sub End If If m16.BackColor = 12632256 Then Call cha2 If m16.BackColor = -2147483624 Then Call pasn If m16.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m18_Click() n2 = 18: n3 = 8 x2 = m18.Caption z1 = m18.Caption If m18.BackColor = 12648384 Then Call cha Exit Sub End If If m18.BackColor = 12648447 Then Call cha1 Exit Sub End If If m18.BackColor = 12632256 Then Call cha2 If m18.BackColor = -2147483624 Then Call pasn If m18.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m20_Click() n2 = 20: n3 = 9 x2 = m20.Caption z1 = m20.Caption If m20.BackColor = 12648384 Then Call cha Exit Sub End If If m20.BackColor = 12648447 Then Call cha1 Exit Sub End If If m20.BackColor = 12632256 Then Call cha2 If m20.BackColor = -2147483624 Then Call pasn If m20.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m22_Click() n2 = 22: n3 = 10 x2 = m22.Caption z1 = m22.Caption If m22.BackColor = 12648384 Then Call cha Exit Sub End If If m22.BackColor = 12648447 Then Call cha1 Exit Sub End If If m22.BackColor = 12632256 Then Call cha2 If m22.BackColor = -2147483624 Then Call pasn If m22.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m24_Click() n2 = 24: n3 = 11 x2 = m24.Caption z1 = m24.Caption If m24.BackColor = 12648384 Then Call cha Exit Sub End If If m24.BackColor = 12648447 Then Call cha1 Exit Sub End If If m24.BackColor = 12632256 Then Call cha2 If m24.BackColor = -2147483624 Then Call pasn If m24.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m26_Click() n2 = 26: n3 = 12 x2 = m26.Caption z1 = m26.Caption If m26.BackColor = 12648384 Then Call cha Exit Sub End If If m26.BackColor = 12648447 Then Call cha1 Exit Sub End If If m26.BackColor = 12632256 Then Call cha2 If m26.BackColor = -2147483624 Then Call pasn If m26.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m28_Click() n2 = 28: n3 = 13 x2 = m28.Caption z1 = m28.Caption If m28.BackColor = 12648384 Then Call cha Exit Sub End If If m28.BackColor = 12648447 Then Call cha1 Exit Sub End If If m28.BackColor = 12632256 Then Call cha2 If m28.BackColor = -2147483624 Then Call pasn If m28.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m30_Click() n2 = 30: n3 = 14 x2 = m30.Caption z1 = m30.Caption If m30.BackColor = 12648384 Then Call cha Exit Sub End If If m30.BackColor = 12648447 Then Call cha1 Exit Sub End If If m30.BackColor = 12632256 Then Call cha2 If m30.BackColor = -2147483624 Then Call pasn If m30.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m32_Click() n2 = 32: n3 = 15 x2 = m32.Caption z1 = m32.Caption If m32.BackColor = 12648384 Then Call cha Exit Sub End If If m32.BackColor = 12648447 Then Call cha1 Exit Sub End If If m32.BackColor = 12632256 Then Call cha2 If m32.BackColor = -2147483624 Then Call pasn If m32.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m34_Click() n2 = 34: n3 = 16 x2 = m34.Caption z1 = m34.Caption If m34.BackColor = 12648384 Then Call cha Exit Sub End If If m34.BackColor = 12648447 Then Call cha1 Exit Sub End If If m34.BackColor = 12632256 Then Call cha2 If m34.BackColor = -2147483624 Then Call pasn If m34.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub m36_Click() n2 = 36: n3 = 17 x2 = m36.Caption z1 = m36.Caption If m36.BackColor = 12648384 Then Call cha Exit Sub End If If m36.BackColor = 12648447 Then Call cha1 Exit Sub End If If m36.BackColor = 12632256 Then Call cha2 If m36.BackColor = -2147483624 Then Call pasn If m36.BackColor = 8421631 Then Call pasy Me.Height = 27 End Sub Private Sub pag_set_Click() If pag_set.ForeColor = -2147483634 Then Call alll Me.Height = 62 For i = 1 To 4 Me.Controls("b" & i).ForeColor = 65535 Me.Controls("b" & i).Top = 30 Me.Controls("b" & i + 4).Top = 48 Next i For i = 3 To (Application.WorksheetFunction.CountA(Sheet1.Range("f8:hh8")) * 2) + 3 Sheet1.Cells(2, i + 2) = Application.WorksheetFunction.VLookup(Sheet1.Range("c1").Value, Sheet1.Range("c10:hh5000"), i, 0) Next i Else MsgBox "عذراً ... لا تملك الصلاحية لهذه العملية ", 48, "BESSAFI" End If End Sub Private Sub UserForm_Activate() For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1 Sheets(i).Name = Sheet1.Cells(7, (i * 2) + 2) Sheets(i).Visible = xlSheetVeryHidden Next If Sheet1.[e2] = "Yes" Then acess_set.ForeColor = -2147483634 pag_set.ForeColor = -2147483634 Else acess_set.ForeColor = 12632256 pag_set.ForeColor = 12632256 End If End Sub Private Sub UserForm_Initialize() 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) Me.Height = 27 End Sub Private Sub x5_Click() If x4 = "" Then Exit Sub Sheets(n3).Name = x4.Value Sheet1.Cells(7, n2) = x4.Text Sheet1.Cells(8, n2) = x4.Text For i = 2 To Application.WorksheetFunction.CountA(Sheet1.Range("f7:dd7")) + 1 Sheets(i).Name = Sheet1.Cells(7, (i * 2) + 2) Next x4 = "" Me.Height = 27 MsgBox " لقد تم تعديل إسم الصفحة بنجاح ", 48, "hosami" End Sub Private Sub z2_Click() Sheets(n3).Visible = xlSheetVisible Application.DisplayAlerts = False Sheets(n3).Select ActiveWindow.SelectedSheets.Delete Sheet1.Select Sheet1.Columns(n2 + 1).Delete Sheet1.Columns(n2).Delete Me.Height = 27 Sheet1.Select Sheet1.ScrollArea = "" With ActiveWindow .ScrollColumn = Range("a1").Column .ScrollRow = Range("a1").Row End With MsgBox " لقد تم إلغاء هذه الصفحة بنجاح ", 48, "hosami" End Sub جزاك الله كل خير وبارك فيك نريد شرح او كيفيه تطويع هذا الكود ليعمل في اي ملف

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

لو سمحتم .. مامعنى حمايه داخليه ومامعنى حمايه خارجيه

ربنا يجزيك خيرا استاذ ابو غبد الباري

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

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

جزاكم الله خيرا

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

لماذا الرقم 36 بالذات والرقم 30 بالذات

'كود معاينة طباعة Sub printpreview() ActiveWindow.SelectedSheets.printpreview End Sub الصفحات محميه نرجو فكها او ماهو الرقم السري

ملفك يا استاذ ايمن به جهد ملحوظ بارك الله فيك وهذا كود موجود بداخله من الروائع ليستفيد منه الجميع والدعاء الطيب موصول لصاحبه Sub printpreview1() 'كود معاينة طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).printpreview End Sub Sub print_2() 'كود طباعة مطاطي Range("a4:aa" & Cells(Rows.count, "c").End(xlUp).Row).PrintOut End Sub

مش فاهم الرقم 36 الموجود بالكود وكذلك الرقم 30

ملحوظه سليمه الكود يضع تذييلات اكثر من المطلوب

يجزيك الله كل خير استاذ ياسر العربي خل يمكن جعل هذا السطر مرن مطاط حسب عدد الطلبه .. لتزيد السرعه

الله يجزيكم الخير

هات الرابط هات الرابط الاساسي لنجتهد في حل مشكلتك اذا كان تم الحل فارفق النسخه النهائيه ليستفيد غيرك كما استفدت

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