كود للتنبيه

كود للتنبيه

Code VBA

To Audible alarm + flashing red and blue

كود فيجوال بيسك ابلكيشن اكسل

للتنبيه صوتيا مع وميض باللونين الأحمر والأزرق

كثيرا نجد أن هناك عدة تساؤلات بكثير من المدونات والمواقع والمنتديات عن "التنبيه"
بالطبع هناك عدة طرق وشفرات مختلفة منها ما هو خاص بطبيعة الملف أو خاص بسؤال محدد بهذه الجزئية

ولكن الطريقة التى سوف أعرضها عليكم تشمل طريقتين فى آن واحد
التنبيه صوتيا
والتنبيه بالوميض بدلا من تلوين النص ويكون ثابتا

فالتنبيه يعمل بناء على شرط ، ووضعنا الشرط هنا فى الشفرة ( الكود) على أساس أقل من رقم (40)
وفى نطاق محدد ، بالطبع يمكنك تغيير النطاق والشرط وجعله أكبر من أو يساوى ، كيفما تشاء

فالكود مرن ويقبل التعديل عليه بسهوله

ويمكنك أيضا الإستغناء عن التنبيه الصوتى وترك التنبيه الفلاشى (الوميض)
ويمكنك تغيير الألوان كيفما تشاء

فلنلقي نظرة سريعة على كيفية عمل الكود من خلال الصورة التالية

تجد بالصورة أعلاه
عند الضغط على زر Start تبدأ الشفرة فى عملها داخل النطاق المحدد وبناء على الشرط الموجود وهو أقل من (40) ويعمل من خلال حلقة تكرارية
فكل رقم بالنطاق أقل من (40) يبدأ فى أخذ اللون الأحمر إلى أن يصل الى آخر رقم بالنطاق ثم يعود من جديد داخل الحلقة التكرارية بالنطاق ويبدأ فى تلوين الأرقام بناء على الشرط التى هى أقل من (40) باللون الأزرق
وبالطبع يعمل التنبيه الصوتي مع التنبيه الفلاشى

وعند الضغط على زر Stop تعود الأرقام داخل النطاق إلى لونها الأصلي ، دون أى تأثير مطلقا على التنسيق
وهذا واضح بالصورة

وتجد بالصورة قمنا بالدخول على محرر الأكواد الـ VBE
وأشرنا بالتحديد على النطاق ، ثم الشرط ، ثم الألوان ، ثم التنبيه الصوتي ، ثم سطر التحكم فى المدة الزمنية بين الصوت الذى يصدر والذى يليه

ولنلق نظرة الكود المستخدم

'Permits any person to use this code provided that the source is mentioned
'https://elshriefacademy.blogspot.com

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Public RunWhen As Double

Sub StartBlink()
    For Each C In ThisWorkbook.Worksheets("Sheet1").Range("B2:B21")
        If C.Value < 40 Then
            With C.Font
                If .ColorIndex = 3 Then ' Red Text
                    .ColorIndex = 32 ' Blue Text
                Else
                    .ColorIndex = 3 ' Red Text
                End If
            End With
            Beep 500, 200
        Else
            C.Font.ColorIndex = xlAutomatic
        End If
    Next
    RunWhen = Now + TimeSerial(0, 0, 2)
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , True
End Sub

Sub StopBlink()
    ThisWorkbook.Worksheets("Sheet1").Range("B2:B21").Font.ColorIndex = _
        xlColorIndexAutomatic
    Application.OnTime RunWhen, "'" & ThisWorkbook.Name & "'!StartBlink", , False
End Sub