محمد طاهر عرفه قام بنشر يونيو 8, 2003 قام بنشر يونيو 8, 2003 مرفق ملف به عدد 2 ماكرو الاول يسألك عن رقم اللون ، ثم يختار الخلايا التي بها اللون المناظر و الثاني يعرض لك الالوان و ارقامها بدءا من الخلية الفعالة Sub Find_By_foramt() reask: On Error GoTo errnumb Dim x As Byte x = InputBox("Enter the Color index", "enter color index", 4) errnumb: If Err.Number = 13 Then MsgBox "Type Mismatch, choose a number between 0 and 56" End If 'MsgBox Str(Err.Number) + " : " + Err.Description If IsNull(x) Or x > 56 Or Not IsNumeric(x) Then MsgBox " choose a number between 0 and 56" GoTo reask ' Exit Sub End If Dim Myrow As Long, MyCol As Long Myrow = Selection.Rows.Count MyCol = Selection.Columns.Count Mycells = Selection.Cells.Count Dim MyMatrix() As String, Myind As Long 'Dim myMultipleRange As Range, Mytemp As Range ReDim MyMatrix(Mycells) ' to overcome ubsidedown selection 'Dim myr As Range 'myr = ActiveSheet.Selection Selection.Cells(1, 1).Select Selection.Cells(1, 1).Activate 'myr.Select Myind = 0 For i = 0 To Myrow - 1 For j = 0 To MyCol - 1 If ActiveCell.Offset(i, j).Interior.ColorIndex = x Then Myind = Myind + 1 MyMatrix(Myind) = ActiveCell.Offset(i, j).Address End If Next j Next i If Myind = 0 Then Exit Sub Dim mm As String mm = MyMatrix(1) & "," For i = 2 To Myind - 1 mm = mm & MyMatrix(i) & "," Next If Myind > 0 Then mm = mm + MyMatrix(Myind) + "" Range(mm).Select End Sub Sub Listcolors() ActiveCell.Offset(0, 0).Value = "ColorIndex" ActiveCell.Offset(0, 1).Value = "Color" For i = 1 To 56 ' Selection.Cells.Count ActiveCell.Offset(i, 0).Value = i ActiveCell.Offset(i, 1).Interior.ColorIndex = i Next i End Sub SelectByCellColor.rar 1
الردود الموصى بها
انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد
يجب ان تكون عضوا لدينا لتتمكن من التعليق
انشئ حساب جديد
سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .
سجل حساب جديدتسجيل دخول
هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.
سجل دخولك الان