تبلیغات
آموزش نرم افزار های تخصصی - صدور اخطار بصورت سلولهای چشمک زن دراکسل

اخطاریه در اکسل


یک فایل اکسل را درنظر بگیرید . دراین فایل ما لیستی از داروها رابه همراه تاریخ تولید و تاریخ انقضا هرکدام  ذخیره نموده ایم .حال هدف مااین است که  با استفاده از کد های VBA کاری کنیم که  به محض باز نمودن فایل اکسل داروهایی را که تاریخ انقضای نزدیکی دارند ( مثلا سه روز مانده به انقضای دارو ) برای ما بصورت چشمک زن مشخص شوند تا متوجه اتمام تاریخ مصرف آنها بشویم .

در ادامه مطلب همراه من باشید .

برای شروع کار لیست داروها در جدول زیر را در نظر بگیرید .

اخطاریه در اکسل

فرض کنید تمام داروها در تاریخ امروز تولید شده اند و هر کدام بسته به نوع دارو دارای مدت انقضای متفاوت هستند . تاریخ انقضای هر کدام را بطور جداگانه در ستون مربوطه درج می کنیم .

اخطاریه در اکسل

با گرفتن همزمان دکمه های ALT+F11  به محیط کد نویسی رفته از منوی insert  یک ماژول ایجاد نموده و کدهای زیر را در آن کپی کنید .
Option Explicit

Dim dPeriod As Double
Dim arCellsToBlink()
Dim iCounter As Integer

Dim iRows As Integer

Sub alarm()
    Dim iNoOfDays As Integer
    Dim iDaysToCompare As Integer
   
    iDaysToCompare = Range("Sheet1!D2")
    iRows = ActiveSheet.UsedRange.Rows.Count
   
    ReDim arCellsToBlink(0 To iRows)
    Dim j As Integer
   
    For j = 4 To iRows
        If IsDate(Cells(j, 3)) Then
           
          
            iNoOfDays = DateDiff("d", Cells(j, 2), Cells(j, 3))
           
            Cells(j, 5) = iNoOfDays
           
           
            If iNoOfDays = iDaysToCompare Then
                arCellsToBlink(iCounter) = "Sheet1!C" & j
                iCounter = iCounter + 1
            End If
        End If
    Next j
   
    Call FlashCell
End Sub

Private Sub FlashCell()

    For iCounter = 0 To iRows
        If arCellsToBlink(iCounter) <> "" Then
       
            If Range(arCellsToBlink(iCounter)).Interior.Color = vbRed Then
           
                Range(arCellsToBlink(iCounter)).Interior.Color = vbYellow
                Range(arCellsToBlink(iCounter)).Font.Color = vbBlack
               
            Else
                Range(arCellsToBlink(iCounter)).Interior.Color = vbRed
                Range(arCellsToBlink(iCounter)).Font.ColorIndex = 2
            End If
           
        End If
    Next iCounter

    dPeriod = Now + TimeSerial(0, 0, 1)
   
    Application.OnTime dPeriod, "FlashCell", , True
End Sub


در همین محیط کد نویسی از طریق پنجره پروژه ها گزینه This workbook  را با دو بار کلیک کردن باز نموده و کد زیر را درون آن کپی کنید .



اخطاریه در اکسل


Private Sub Workbook_Open()

Call alarm

End Sub

اکنون در سلول D2 عددی را وارد می کنیم که این عدد در واقع تعداد روزهایی مد نظر ما برای تعیین این است که مثلا کدام داروها 3 روز تا اتمام مهلت مصرف خود فاصله دارند . بعنوان مثال ما در اینجا داروهایی را که فقط 2 روز تا انقضای آنها مانده است را مد نظر داریم بنابر این عدد 2 را وارد می نماییم .

بعد از انجام این کارها فایل خود را بسته و دوباره باز کنید و نتیجه کار را مشاهده کنید .

فایل نمونه را از اینجا دانلود نمایید .



طبقه بندی: آموزش EXCEL،
برچسب ها:اکسل، ماکرو، مهلت انقضا، ماژول،
تاریخ : چهارشنبه 29 فروردین 1397 | 10:22 ب.ظ | نویسنده : امید شهری | نظرات()
.: Weblog Themes By Bia2skin :.