مختار حسين محمود قام بنشر أكتوبر 2, 2015 مشاركة قام بنشر أكتوبر 2, 2015 السلام عليكم ورحمة الله وبركاته وبعد ,,, أقدم لكم اخوتى الأفاضل كودا يقوم بفحص نطاق من الخلايا ويحدد فقط الخلايا التى تحوى معادلات ذات القيم الخاطئة ويميزها بالتلوين أو التعديل أو التفريغ أو بعمل فلاش لتلك الخلايا لك الخيار فى اختيار شكل التمييز المناسب الكود وعليه شرح بعض السطور : Option Explicit Private Declare Function sndPlaySound32 Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName _ As String, ByVal uFlags As Long) As Long Sub CheckRangeForError() ' by mokhtat 2/10/2015 ' Error values include #DIV/0!, #N/A, #NAME?, #NULL!, #NUM!, #REF!, and #VALUE!. Dim C As Range Dim i As Integer Dim PlaySound As Boolean ' تحديد نطاق الفحص Sheets("Sheet1").Range("A2:F20").Select ' تحديد الخلايا التى تتضمن أخطاء Selection.SpecialCells(xlCellTypeFormulas, 16).Select ' استدعاء صوت من أصوات الويندوز للتنبيه على انتهاء الفحص PlaySound = True If PlaySound Then Call sndPlaySound32("C:\windows\media\notify.wav", 1) ' حدد الصوت المفضل لك طبقاً للمسار المقابل End If ' رسالة الى المستخدم بسؤال عن الرغبة فى التمييز أم لا If MsgBox(" تم انتهاء الفحص , هل تريد تمييز الخلايا ؟ ", vbYesNo + vbQuestion) = vbNo Then Exit Sub ' فى حالة اختيار لا يتم الخروج من الاجراء Else ' فى حالة اختيار تعم يتم عمل تمييز للخلايا بالتفريغ أو بالتعديل أو التلوين أو الفلاش ' ------------------------------------------------------------ ' تمييز الخلايا التى بها اخطاء بالتعديل ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Value = "معادلة خاطئة" ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالتفريغ ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Value = "" ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالتلوين ' For Each C In Sheets("Sheet1").Range("A2:F20") ' If IsError(C.Value) Then ' C.Interior.ColorIndex = 3 ' End If ' Next C '------------------------------------------------------------- ' تمييز الخلايا التى بها اخطاء بالفلاش For Each C In Sheets("Sheet1").Range("A2:F20") If IsError(C.Value) Then C.Select With C For i = 1 To 2 ' عدد مرات الوميض Application.Wait (Now + TimeValue("0:00:01")) ' انتظار مؤقت لمدة ثانية .Interior.ColorIndex = 6 Application.Wait (Now + TimeValue("0:00:01")) .Interior.ColorIndex = 7 Next .Interior.ColorIndex = xlNone .Font.Color = -16777024 End With End If Next '------------------------------------------------------------ End If End Sub تفضلوا المرفق وتقبلوا تحياتى select all cells if contains Error value .rar 6 رابط هذا التعليق شارك More sharing options...
عادل حنفي قام بنشر أكتوبر 2, 2015 مشاركة قام بنشر أكتوبر 2, 2015 اخي العزيز مختار حسين محمود تسلم يداك عمل اكثر من رائع تحياتي 1 رابط هذا التعليق شارك More sharing options...
عبد العزيز البسكري قام بنشر أكتوبر 2, 2015 مشاركة قام بنشر أكتوبر 2, 2015 السّلام عليكم و رحمة الله و بركاته و أخيرًا أصبح بإمكاننا عمل سكانير لخلايانا .. طبعًا ليست العصبيّة .. و إنّما الاكسيليّة . كود أكثر من رائع .. بارك الله فيك أستاذنا الغالي مختار حسين محمود .. جزاك الله خيرًا وزادها بميزان حسناتك .. يا رب فائق احتراماتي 3 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 3, 2015 مشاركة قام بنشر أكتوبر 3, 2015 أخي الغالي المتميز مختار يعجبني أسلوبك في التعامل مع الأكواد ..أسلوب جديد ومميز ورائع جزيت خيراً على الموضوع الرائع والذي يستحق منا أن نصفق له بحرارة 2 رابط هذا التعليق شارك More sharing options...
مختار حسين محمود قام بنشر أكتوبر 3, 2015 الكاتب مشاركة قام بنشر أكتوبر 3, 2015 السّلام عليكم و رحمة الله و بركاته أستاذى الفاضل عادل حنفى بارك الله فيك ، سلمت من كل شر ، شرفنى مرورك أستاذى الكريم أخى العزيز زيزو البسكرى بارك الله فيك دائما تشرفنى بمرورك العزيز أخى وأستاذى الغالى ياسر خليل أشكرك بحرارة على هذا التشجيع الدائم والمستمر وهذا ما تعلمته من المنتدى ومنك تحديداً أستاذى الفاضل 2 رابط هذا التعليق شارك More sharing options...
Yasser Fathi Albanna قام بنشر أكتوبر 3, 2015 مشاركة قام بنشر أكتوبر 3, 2015 سلمت يمينك أخى الحبيب مختار عمل أكثر من رائع وإلى الأمام دائما وفقك الله 1 رابط هذا التعليق شارك More sharing options...
مختار حسين محمود قام بنشر أكتوبر 3, 2015 الكاتب مشاركة قام بنشر أكتوبر 3, 2015 أخى الحبيب ياسر فتحى بارك الله فيك ، سلمت من كل شر ، يشرفنى مرورك وتشجيعك الدائم يا بش مهندس 1 رابط هذا التعليق شارك More sharing options...
محمد الورفلي1 قام بنشر أكتوبر 4, 2015 مشاركة قام بنشر أكتوبر 4, 2015 السلام عليكم استاذ مختار كود جميل و دقيق وشرح مبسط شكراً لحسن توصيل المعلومة .............وكما قال الاستاذ ياسر خليل .أسلوب جديد ومميز ورائع بارك الله فيك واستغل هذه الفرصه للاساتذة الافاضل ان يقومو مشكورين عند وضع كود بشرحه حتى يتسنا لنا فهم الكود والتعديل عليه وتوفير وقت وجهد الشخص الذي يريد المساعدة ........فلا تحرمونا من شرح الاكود ..... 1 رابط هذا التعليق شارك More sharing options...
مختار حسين محمود قام بنشر أكتوبر 5, 2015 الكاتب مشاركة قام بنشر أكتوبر 5, 2015 (معدل) السلام عليكم بارك الله فيك أخى الحبيب محمد يشرفنى مرورك وأضيف لكلامك أن شرح الأكواد لا يوفر وقت وجهد المساعد فقط وانما يوفر وقت وجهد طالب المساعدة أيضاً تم تعديل أكتوبر 5, 2015 بواسطه مختار حسين محمود رابط هذا التعليق شارك More sharing options...
جعفر الطريبق قام بنشر أكتوبر 5, 2015 مشاركة قام بنشر أكتوبر 5, 2015 كود جميل للاستاد الفاضل مختار حسين عند بعض الملاحظات 1- من الأفضل اضافة Error Handling للكود لتفادي ال RunTime error في حالة عدم وجود أي خلايا تحتوي على معادلات في الصفحة 2- يمكن الاستغناء عن Select ليكون الكود أسرع 3- في حالة وجود أكثر من خلية حاوية لمعادلة يمكن اشغال الوميض على كل الخلايا مرة واحدة في نفس الوقت .. هدا الأمر من شانه الاسراع بالكود خصوصا لو وجدت خلايا عديدة 4- من الأحسن تغيير شكل الكود بحيث يصبح التعديل و التفريغ و التلوين و الوميض Arguments يتم اختيارهم من طرف المستخدم .. هدا من شأنه اعطاء للكود مرونة كبيرة 1 رابط هذا التعليق شارك More sharing options...
محمد حسن المحمد قام بنشر أكتوبر 5, 2015 مشاركة قام بنشر أكتوبر 5, 2015 السلام عليكم أخي الأستاذ مختار حسين جزاك الله خير...عمل متميز أرجو أن يدخل حيز التنفيذ للدلالة على الأخطاء في مجالات الحياة والعمل، بعد ملاحظات الأستاذ المحترم جعفر ما تقدمونه رائع حقاً ..تقبل تحياتي 1 رابط هذا التعليق شارك More sharing options...
مختار حسين محمود قام بنشر أكتوبر 5, 2015 الكاتب مشاركة قام بنشر أكتوبر 5, 2015 أخى وأستاذى العزيز جعفر أشكرك بجد على هذا النقد البنّاء فبه نتعلم ونتقدم لكن هذا ما كان وليس فى الامكان الا ما كان فأنا لم أصل بعد الى هذا المستوى من الحرفية والسرعة فى انشاء الأكواد أخى الأستاذ الفاضل محمد حسن مشكور على مرورك وكلامك الطيب تقبل الله منا ومنكم صالح الأعمال رابط هذا التعليق شارك More sharing options...
جعفر الطريبق قام بنشر أكتوبر 5, 2015 مشاركة قام بنشر أكتوبر 5, 2015 (معدل) السلام عليكم يا أستادي الفاضل مختار حسين فعلا نحن كلنا هنا لنتعلم و لهدا نحاول دائما تحسين أعمالنا قدر الامكان ... أنا أعتبر كل سؤال أو مشاركة فرصة للتعلم و لتحسين خبراتنا اليك هدا التعديل للكود فهو يتحسب مسبقا لأي أخطاء ممكن أن تحدث كما أنه أسرع و أكثر مرونة بسبب ال Enum Argument ممكن اضافة ميزة أخرى للكود ألا و هي اعطاء المستخدم امكانية ارجاع الخلايا كما كانت قبل التفريغ أو التعديل أو التلوين ملف للتحميل : https://app.box.com/s/3tmxv0k3xxzj3fg6616oounfugns55si الكود في موديول عادي: Option Explicit Private Enum ActionToTake EditCells = 0 EmptyCells = 1 ColorCells = 2 FlashCells = 4 End Enum Private Declare Function sndPlaySound32 Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName _ As String, ByVal uFlags As Long) As Long Sub test() Dim eAction As ActionToTake Dim sAction As String Dim oTargetRange As Range Set oTargetRange = Sheet1.Range("A1:K20") eAction = FlashCells Select Case eAction Case EditCells sAction = "edit" Case EmptyCells sAction = "clear" Case ColorCells sAction = "change the color of" Case FlashCells sAction = "flash" End Select If MsgBox("You are about to " & sAction & " the cells in the Range : " & vbCr & vbCr & _ oTargetRange.Address(external:=True) & vbCr & vbCr & "Go ahead ?", vbExclamation + vbYesNo) = vbYes Then If CheckRangeForErrors(Target:=oTargetRange, WhichAction:=eAction) = False Then MsgBox Err.Description End If End If End Sub Private Function CheckRangeForErrors( _ ByVal Target As Range, _ Optional ByVal WhichAction As ActionToTake = FlashCells _ ) _ As Boolean Dim oCellsWithErrorFormulae As Range Dim oCell As Range Dim ar() As Long Dim j As Long Dim i As Long Dim t As Single On Error Resume Next Set oCellsWithErrorFormulae = Target.SpecialCells(xlCellTypeFormulas, 16) If Not oCellsWithErrorFormulae Is Nothing Then With oCellsWithErrorFormulae Select Case WhichAction Case EditCells .Value = "Error Edited" Case EmptyCells .ClearContents Case ColorCells .Interior.Color = vbRed Case FlashCells ReDim ar(1 To .Cells.Count) For Each oCell In .Cells i = i + 1 ar(i) = oCell.Interior.ColorIndex Next oCell For i = 1 To 4 Call sndPlaySound32("C:\windows\media\notify.wav", 1) .Cells.Interior.ColorIndex = 3 t = Timer Do DoEvents Loop Until Timer - t >= 0.2 j = 0 For Each oCell In .Cells j = j + 1 oCell.Interior.ColorIndex = ar(j) Next oCell t = Timer Do DoEvents Loop Until Timer - t >= 0.2 Next i i = 0 For Each oCell In .Cells i = i + 1 oCell.Interior.ColorIndex = ar(i) Next oCell Erase ar Set oCellsWithErrorFormulae = Nothing Set oCell = Nothing End Select End With CheckRangeForErrors = True End If End Function تم تعديل أكتوبر 5, 2015 بواسطه جعفر الطريبق 3 رابط هذا التعليق شارك More sharing options...
مختار حسين محمود قام بنشر أكتوبر 5, 2015 الكاتب مشاركة قام بنشر أكتوبر 5, 2015 أخى الغالى جعفر أنت عبقرى بمعنى الكلمة لكن الكود لم يصبح أكثر مرونة فهو الأن قاصر على الفلاش فقط المرونة المنشودة هى أن يستطيع المستخدم أن يختار بين اما أن تفرغ المعادلات الخاطئة أو تلون أو تعطى قيمة معينة أو اشعال الوميض فيها فيمكن اضافة input box يدخل فيه المستخدم رقما 1 أو 2 أو 3 أو 4 1 تعمل التفريغ 2 تلون 3 تعطى قيمة 4 تشعل الوميض أعتقد أن هذا يعطى مرونة أكثر أرجو أن تكون الفكرة واضحة رابط هذا التعليق شارك More sharing options...
جعفر الطريبق قام بنشر أكتوبر 5, 2015 مشاركة قام بنشر أكتوبر 5, 2015 الاستاد الفاضل مختار حسين شكرا على المتابعة في بداية الماكرو Test توجد ال Variable eAction و ال Variable oTargetRange ... فالاولى تعطي الكود امكانية اختيار مجال الخلايا و الثانية اختار التلوين أو التفريغ أو الوميض .. تلك هي المرونة التي كنت أقصدها و هي مرونة على مستوى الكود و تجعله مرتبا و مرنا و سهلا أما على مستوى المستخدم فنعم يمكن اضافة InputBox او فورم كما تفضلت 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر أكتوبر 5, 2015 مشاركة قام بنشر أكتوبر 5, 2015 أخي الحبيب مختار أخي الحبيب جعفر بارك الله فيكما وجزاكما الله خير الجزاء في الدنيا والآخرة 1 رابط هذا التعليق شارك More sharing options...
مختار حسين محمود قام بنشر أكتوبر 6, 2015 الكاتب مشاركة قام بنشر أكتوبر 6, 2015 أخى وأستاذى الغالى جعفر زادك الله بسطةً فى العلم و الرزق أشكرك على هذا التوضيح أخى وأستاذى الغالى ياسر زادك الله بسطةً فى العلم و الرزق أشكرك على هذا الدعاء 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان