ابو اسامة العينبوسي

السلام عليكم عمل متقن وفعلا جميل جدا

السلام عليكم الاستاذ الفاضل ابو تامر بورك فيك و جزيت خيرا يا نبع العطاء

السلام عليكم الاخ شيبانى استخدم هذه مباشره في خليه واحده بدل العمود f =IF(E5<>"",IF(E5=(A5)*(C5),"أنت رائع يا "&C2&" واصل", "آسف "&C2&", العملية خاطئة , حاول

السلام عليكم ممكن If Target.Row = 1 Or Target.Column = 1 Or Target.Row > 21 Or Target.Column > 21 Or Target.Cells.Count > 1 Then Exit Sub With Range("data") .ClearContents .Cells.Interior.ColorIndex = xlNone End With Range("sqrng").ClearContents Range(Cells(2, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 44 Range(Cells(Target.Row, 2), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 44 Target.Value = Cells(1, Target.Column) * Cells(Target.Row, 1) Cells(Target.Row, 22) = Target ^ 0.5 If Cells(Target.Row, 22) - Int(Cells(Target.Row, 22)) <> 0 Then Cells(Target.Row, 22) = "áíÓ áå ÌÐÑ" Else Cells(Target.Row, 22) = Target ^ 0.5 End If Target.Interior.ColorIndex = 6 MyZoom = ActiveWindow.Zoom ActiveWindow.Zoom = 120 Application.Wait (Now() + TimeValue("00:00:01")) ActiveWindow.Zoom = MyZoom _SQRT.rar

السلام عليكم Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveSheet.Protect '-------------------------------------------------------------- If Target.Column < 13 And Range("x" & Target.Row) = "عادل" Then ActiveSheet.Unprotect End If '--------------------------------------------------------------- If Target.Column > 12 And Range("x" & Target.Row) = "محمد" Then ActiveSheet.Unprotect End If End Sub test_it3.rar

السلام عليكم استاذ اكرم عودا حميدا افتقدت كثير

السلام عليكم اقر الله بها(مريم ) عينك و اسعدك بها شكرا لمرورك و لكل اسرة اوفسينا

السلام عليكم استخدم هذا الكود (تجربه فقط) مع عادل Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column < 2 Or Target.Column > 12 And Range("x" & Target.Row) = "ÚÇÏá" Then ActiveSheet.Protect Else ActiveSheet.Unprotect End If End Sub

السلام عليكم لانك لم تقم بتسمية مدى المدى من B2:M13 سمه Data

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

السلام عليكم على عجاله Private Sub Worksheet_Change(ByVal Target As Range) Dim Myt As Range Set Myt = Target If Target.Column = 2 Then If Target.Offset(0, 3) <> "ÚÇÏá" Then MsgBox "ããäæÚ áÇäå ÛíÑ ÚÇÏá", vbCritical, "ããäæÚ" Myt.Select End If ElseIf Target.Column = 3 Then If Target.Offset(0, 2) <> "ãÍãÏ" Then MsgBox "ããäæÚ áÇäå ÛíÑ ãÍãÏ", vbCritical, "ããäæÚ" Myt.Select End If End If End Sub تصبح على خير test_it.rar

السلام عليكم مساهمه بسيطه بجدول الضرب للصغار Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row = 1 Or Target.Column = 1 Or Target.Row > 13 Or Target.Column > 13 Or Target.Cells.Count > 1 Then Exit Sub With Range("data") .ClearContents .Cells.Interior.ColorIndex = xlNone End With Range(Cells(2, Target.Column), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 44 Range(Cells(Target.Row, 2), Cells(Target.Row, Target.Column)).Interior.ColorIndex = 44 Target.Value = Cells(1, Target.Column) * Cells(Target.Row, 1) Target.Interior.ColorIndex = 6 MyZoom = ActiveWindow.Zoom ActiveWindow.Zoom = 120 Application.Wait (Now() + TimeValue("00:00:02")) ActiveWindow.Zoom = MyZoom End Sub بالاضافه الى رابط لملفات تعليميه للاكسل ( وليس البيسك) ‫ إضغط هنا‬ __________.rar

السلام عليكم بهذا الكود Sub CombineTextFiles() Dim FilesToOpen Dim x As Integer Dim wkbAll As Workbook Dim wkbTemp As Workbook Dim sDelimiter As String On Error GoTo ErrHandler Application.ScreenUpdating = False sDelimiter = "|" FilesToOpen = Application.GetOpenFilename _ (FileFilter:="Excel Files (*.xls), *.xls", _ MultiSelect:=True, Title:="Text Files to Open") If TypeName(FilesToOpen) = "Boolean" Then MsgBox "No Files were selected" GoTo ExitHandler End If Set wkbAll = ActiveWorkbook x = 1 Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) xx = Application.InputBox("ادخل عدد الاوراق المراد نسخها") For i = 1 To xx wkbTemp.Sheets(i).Copy After:=wkbAll.Sheets(wkbAll.Sheets.Count) Next i wkbTemp.Close (False) wkbAll.Worksheets(wkbAll.Sheets.Count).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:="|" x = x + 1 While x <= UBound(FilesToOpen) Set wkbTemp = Workbooks.Open(Filename:=FilesToOpen(x)) With wkbAll wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count) .Worksheets(x).Columns("A:A").TextToColumns _ Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, Semicolon:=False, _ Comma:=False, Space:=False, _ Other:=True, OtherChar:=sDelimiter End With x = x + 1 Wend ExitHandler: Application.ScreenUpdating = True Set wkbAll = Nothing Set wkbTemp = Nothing Exit Sub ErrHandler: MsgBox Err.Description Resume ExitHandler End Sub TEST2.rar

السلام عليكم ممكن بعدة طرق منها داله Left اخى خبور لم ارى مشاركتك With_Left_Function.rar

السلام عليكم شكرا اخى خبور طننت انه يريد الدواير على العمود AN شكرا لك

السلام عليكم هل تريد الدائره على العلامات في شيت الشهاده اليك الملف كاملا ________12.rar ________312.rar

السلام عليكم مشكور على هذه المعلومه

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

السلام عليكم حملت ملفك ولم افهم المطلوب

اخى سالم من هنا R = ActiveCell.Row بورك في همتك اخى ابو تامر

السلام عليكم days2.rar

السلام عليكم لاثراء الموضوع ممكن هكذا ايضا abuxx2.rar

السلام عليكم هنا حلين هل التضليل بالتنسيق الشرطى و مثال على رسم مربع على نصف الخلية النشطه ActiveSheet.Shapes.AddShape(msoShapeRectangle, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width / 2, ActiveCell.Height).Select Book15.rar

السلام عليكم بالنسبه لتلوين الصفوف و الاعمده هذا الحل Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub ActiveSheet.Cells.Interior.ColorIndex = xlNone Range(Cells(1, Target.Column), Cells(65536, Target.Column)).Interior.ColorIndex = 35 Range(Cells(Target.Row, 1), Cells(Target.Row, 255)).Interior.ColorIndex = 35 Target.Interior.ColorIndex = 34 End Sub اما بالنسبه لتقسيم الخليه كان لنا حل سابق وهو رسم مربع على نصف عرض الخليه المطلوبه ان اردت ادرج لك الحل _________.rar

السلام عليكم اللهم امين و عقبال عضوية MVP