Tablodaki renkli hücreleri süzme

[immense44]

Merhabalar,

Üretim alanında kalibrasyon gereken cihazlar için bir tablo yaptım ve kalibrasyon süresine bir ay kala hücreleri koşullu biçimlendirerek sarı dönüşmesini sağladım. Kalibrasyonlar yapıldıkça manuel olarak girişler yapılıyor. Yapmak istediğim şey kalibrasyonu yaklaşan (yani sarıya dönüşen hücreleri) cihazları süzüp bana 15 günde bir otomatik mail atacak bir makro yazmak istiyorum.

Ek olarak makro dosya açılmadan da çalışabilir mi?

Yardımcı olabilir misiniz?

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu dosyanıza uygulayın.

Dosyanızdaki ilk iki satırdaki birleştirmeleri tamamen iptal edin. Yoksa kod çalışmaz.

Dosyanızı makro içeren dosya biçiminde kayıt edip kapatın. Windows zamanlanmış görevler menüsünden 15 günlük periyotlara göre dosyanızı açacak şekilde görev oluşturun. Bu şekilde dosyanız açıldığı anda sarı renkli hücreler mail penceresine aktarılacaktır. Size sadece kontrol edip gönder butonuna tıklamak kalıyor.

Sub Auto_Open()
    Dim Alan As Range, Son As Long
    Dim OutApp As Object, OutMail As Object
    
    ActiveSheet.Range("A2").AutoFilter
    ActiveSheet.Range("A2:L" & Rows.Count).AutoFilter Field:=12, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor
    Son = Cells(Rows.Count, 1).End(3).Row
    
    Set Alan = Nothing
    On Error Resume Next
    Set Alan = Range("A1:L" & Son)
    On Error GoTo 0

    Alan.Copy

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "aaaa.bbbbb@cccc.com"
        .CC = ""
        .BCC = ""
        .Subject = "Kalibrasyon Planı"
        .Display
         DoEvents
         SendKeys "^v", True
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub