روعه اضافه صف اوصفوف بعد بيانات الطلاب للاستاذ ياسر خليل
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim sh As Worksheet
Dim lr As Long
Dim lc As Long
Dim c As Long
Set ws = Sheets("بيانات الطلبة")
c = ws.Range("Q1").Value
If TextBox1.Text = ws.Range("F1") Then
Me.Hide: TextBox1.Text = ""
MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب", 64
Application.ScreenUpdating = False
Application.Calculation = xlManual
If ws.Range("Q1") < 1 Then Exit Sub
For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف ناجح", "الحاله", "كنترول شيت", "رصد الترم الثانى", "كنترول شيت (2)", "رصد الترم الأول", "كشف الدور الثاني"))
lr = IIf(LastRowColumn(sh, "R") = 9, 9, LastRowColumn(sh, "R"))
lc = LastRowColumn(sh, "C")
sh.Range("A" & lr).Resize(1, lc).AutoFill Destination:=sh.Range("A" & lr).Resize(c + 1, lc)
On Error Resume Next
sh.Range("A" & lr + 1).Resize(c, lc).SpecialCells(xlCellTypeConstants).ClearContents
Next sh
Application.Goto ws.Range("A1")
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Unload Me
Else
MsgBox "عفواً كلمة المرور خاطئه و لن يتم تنفيذ المطلوب", vbExclamation
TextBox1.Text = ""
TextBox1.SetFocus
End If
End Sub
Function LastRowColumn(ws As Worksheet, rc As String) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(ws.Cells) <> 0 Then
With ws
If UCase(rc) = "R" Then
lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
ElseIf UCase(rc) = "C" Then
lng = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
End If
End With
Else
lng = 1
End If
LastRowColumn = lng
End Function
Private Sub UserForm_Click()
End Sub
لو شويه شرح في الكود لان فيه جديد علينا
