Soru Makro Bazlı Uyarı Mesajlarında "Uyarıyı Almak İstemiyorsanız Evet/Hayır" Mesajı Ekleme

fledermaus · 10 Mart 2022

Merhaba,

Ekte paylaşmış olduğum dosyamda geçen makrolar;

1- Saat Uyarısı : Ay sayfalarındaki K3 hücrelerine ve son sayfanın E-F sütunlarında geçen alt/üst sınır saatlere.

2- Tarih Uyarısı : Ay sayfalarındaki H sütununa ve güncel takvime bağlı olarak E-F sütunlarında geçen alt/üst sınır tarihlere göre

uyarı mesajları vermektedirler.

Söz konusu makrolarda bahsetmiş olduğum uyarıları "bir daha uyarıyı almak istemiyorsanız evet/hayır" uyarısı ekleyerek nasıl devem ettirebilir yada kesebiliriz?

Yardımları için şimdiden herkese çok teşekkür ederim.

Syg,

fledermaus · 10 Mart 2022

Merhaba,

Eksik bilgi vermemek adına bir bilgilendirme daha yapmak istedim.

Söz konusu dosyanın H sütununa saat verileri girilmekte ve K3 hücresi buna bağlı olarak güncellenmekte ve değişmektedir.

Dosya kullanımındaki amaç farklı güncel saat verilerini (K3 gibi) takip etmektir.

Makrolardaki amaç ise bu verilere ilişkin belirli zaman ve tarih aralıklarında uyarı mesajları ile hatırlatma almaktır.

Dosyada geçen makro uyarıları şu anda sadece K3 hücresine bağlı alt/üst sınır saat değişimine ve alt/üst sınır güncel takvim değişimlerine göre uyarı vermektedir.

Burada asıl amaç, H sütununa girilen saat verilerinden dolayı belirli tarihlerde sürekli çıkan uyarı mesajını bir kere aldıktan sonra isteğe bağlı olarak kapatabilmektir.

( Son sayfadaki E sütununda geçen tarih aralıklarından birini bugünün tarihi ile (yada dosyayı denediğiniz tarih) ile değiştirir ve herhangi bir sayfanın H sütununa H7 den itibaren saat verisi yazmayı denerseniz uyarı mesajı alırsınız)

Tarih uyarılarında kod tetikleyicisi olarak H sütununun atanmasının nedeni ise;

diyelim gece yarısından hemen önce dosyayı açtık ve tarih, açılışta otomatik kontrol edildi ve tarihe göre uyarıya gerek yok,
gece yarısı geçildiğinde ise uyarı tarihine denk geliyor diyelim ve belge açık durumda. Bu durumda dosya açık olduğunda herhangi bir tetikleme olmayacaktı. Bu nedenle kod tetikleyicisi olarak sürekli kullanılan H sütunu seçildi.

Umarım yeterince açıklayıcı ve doğru anlatabilmişimdir.

Syg,

fledermaus · 11 Mart 2022

Merhaba,

Konuyla ilgili yardımcı olabilecek biri var mıdır ?

Nıot: Yapmak istediğim ekleme sadece tarih değil saat uyarısında da kullanılacaktır.

Syg,

fledermaus · 11 Mart 2022

Merhaba,

Kim yardımcı olabilir ?

Syg,

YUSUF44 · 11 Mart 2022

Makrolarda ilgili bölümlerde aşağıdaki gibi değişiklik yaparak dener misiniz?

PHP:

            If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And uyari.Cells(i, 5).Interior.Color = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    uyari.Cells(i, 5).Interior.Color = vbRed
                Else
                    uyari.Cells(i, 5).Interior.Color = xlNone
                End If
            End If

fledermaus · 11 Mart 2022

YUSUF44' Alıntı:

Makrolarda ilgili bölümlerde aşağıdaki gibi değişiklik yaparak dener misiniz?

PHP:

            If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And uyari.Cells(i, 5).Interior.Color = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    uyari.Cells(i, 5).Interior.Color = vbRed
                Else
                    uyari.Cells(i, 5).Interior.Color = xlNone
                End If
            End If

Merhaba,

Hocam denedim ancak bir yerde yanlışlık yaptım sanırım olmadı.

Bendeki kodu buradan paylaşıyorum. Rica etsem düzeltmeleri birde siz yapabilir misiniz ?

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
ActiveSheet.Name = "REPORT-1" Or _
ActiveSheet.Name = "REPORT-2" Then Exit Sub
If IsError(Range("K3")) Then Exit Sub
Zaman = Range("K3").Value
Set uyari = Sheets("MAINTENANCE MONITORING")
For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
If IsDate(uyari.Cells(i, 5)) Then
If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date Then
Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
& Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
End If
Else
If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman Then
Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
& Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
End If
End If
Next i
If Not Mesaj = Empty Then
MsgBox Mesaj, vbCritical
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
ActiveSheet.Name = "REPORT-1" Or _
ActiveSheet.Name = "REPORT-2" Then Exit Sub
If IsError(Range("K3")) Then Exit Sub

If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
Zaman = Range("K3").Value
Set uyari = Sheets("MAINTENANCE MONITORING")
For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
If IsDate(uyari.Cells(i, 5)) Then
If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date Then
Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
& Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
End If
Else
If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman Then
Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
& Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
End If
End If
Next i
If Not Mesaj = Empty Then
MsgBox Mesaj, vbCritical
End If
End Sub

Syg,

fledermaus · 12 Mart 2022

Tekrar Merhaba,

Yardımcı olabilecek birileri var mıdır?

Syg,

fledermaus · 13 Mart 2022

Merhaba,

Konuyla ilgili yardımcı olabilecek birileri var mıdır?

Syg.

YUSUF44 · 14 Mart 2022

Dosyayı benim verdiğim kodları ekledikten sonra buraya yükler misiniz?

fledermaus · 14 Mart 2022

YUSUF44' Alıntı:
Dosyayı benim verdiğim kodları ekledikten sonra buraya yükler misiniz?

Merhaba,

Dosya ektedir. Makro çok fazla bilmediğim için reviyonu yanlış yapmış olabilirim.

Teşekkürler.

Syg,

YUSUF44 · 14 Mart 2022

Thisworkbook kısmındaki kodlar şöyle olmalı ama dosyanın çalışma mantığını anlamadığım için kodlar düzgün çalışıyor mu diye deneyemedim:

PHP:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And uyari.Cells(i, 6).Interior.Color = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
            If sor = vbYes Then
                uyari.Cells(i, 6).Interior.Color = vbRed
            Else
                uyari.Cells(i, 6).Interior.Color = xlNone
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And uyari.Cells(i, 5).Interior.Color = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    uyari.Cells(i, 5).Interior.Color = vbRed
                Else
                    uyari.Cells(i, 5).Interior.Color = xlNone
                End If
            End If
        End If
    Next i
    If Not Mesaj = Empty Then
        MsgBox Mesaj, vbCritical
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
    
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And uyari.Cells(i, 6).Interior.Color = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
            If sor = vbYes Then
                uyari.Cells(i, 6).Interior.Color = vbRed
            Else
                uyari.Cells(i, 6).Interior.Color = xlNone
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And uyari.Cells(i, 5).Interior.Color = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    uyari.Cells(i, 5).Interior.Color = vbRed
                Else
                    uyari.Cells(i, 5).Interior.Color = xlNone
                End If
            End If
        End If
    Next i
    If Not Mesaj = Empty Then
        MsgBox Mesaj, vbCritical
    End If
End Sub

fledermaus · 14 Mart 2022

YUSUF44' Alıntı:

Thisworkbook kısmındaki kodlar şöyle olmalı ama dosyanın çalışma mantığını anlamadığım için kodlar düzgün çalışıyor mu diye deneyemedim:

PHP:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And uyari.Cells(i, 6).Interior.Color = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
            If sor = vbYes Then
                uyari.Cells(i, 6).Interior.Color = vbRed
            Else
                uyari.Cells(i, 6).Interior.Color = xlNone
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And uyari.Cells(i, 5).Interior.Color = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    uyari.Cells(i, 5).Interior.Color = vbRed
                Else
                    uyari.Cells(i, 5).Interior.Color = xlNone
                End If
            End If
        End If
    Next i
    If Not Mesaj = Empty Then
        MsgBox Mesaj, vbCritical
    End If
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
   
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And uyari.Cells(i, 6).Interior.Color = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
            If sor = vbYes Then
                uyari.Cells(i, 6).Interior.Color = vbRed
            Else
                uyari.Cells(i, 6).Interior.Color = xlNone
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And uyari.Cells(i, 5).Interior.Color = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    uyari.Cells(i, 5).Interior.Color = vbRed
                Else
                    uyari.Cells(i, 5).Interior.Color = xlNone
                End If
            End If
        End If
    Next i
    If Not Mesaj = Empty Then
        MsgBox Mesaj, vbCritical
    End If
End Sub

Merhaba,

Hocam çalışmadı. Yani makrolar genel olarak hiç çalışmadı. Normal uyarıları da vermedi.

Syg,

YUSUF44 · 14 Mart 2022

Önceki mesajımda da belirttiğim gibi dosyanın çalışma mantığını anlamadığımdan kodları deneme şansım olmadı. Somut örneklerle açıklarsanız bakmaya çalışırım.

fledermaus · 14 Mart 2022

YUSUF44' Alıntı:
Önceki mesajımda da belirttiğim gibi dosyanın çalışma mantığını anlamadığımdan kodları deneme şansım olmadı. Somut örneklerle açıklarsanız bakmaya çalışırım.

Merhaba,

Paylaşılan dosyanın H sütununa (H8 den itibaren) bir cihazın günlük bakım saatleri giriliyor. Saatler girildikçe K3 hücresi kümülatif olarak artıyor. (Yani son sayacı gösteriyor)

Bu dosyadaki amaç cihazın ne kadar saat çalıştığını görebilmek ve bunu yaparken de aynı zamanda bakımlarını aksatmadan takip edebilmek.

Bazı bakımlar saate, bazı bakımlar ise takvime dayalı. Son sayfadaki saat ve tarih alt/üst sınırlarının amacı cihazın bakım saatlerini aksatmamaya yönelik.

Mesela bakımlardan bir tanesi (son sayfanın 3. satırındaki bakım) 3.748:00 ci saatte. Biz bu saati aşmamak için 20 saat kala yani yaklaşık 3.728-3729 saatleri arasında bir uyarı kriteri oluşturuyoruz.

Bunu amacı, cihazın çalıştığı saatleri girerken personele bakıma belirli bir saat aralığı kaldığını hatırlatmak. Mesela bu uyarıdan sonraki cihazın ilk çalışma programı 22 saat sürecekse cihazı tekrar çalıştırmıyor ve bakıma alıyoruz.

Bazı bakımlar ise tarihe dayalı.

Tarih uyarılarında kod tetikleyicisi olarak H sütununu kullanıyoruz, bunun nedeni ise;

diyelim gece yarısından hemen önce dosyayı açtık ve tarih, açılışta otomatik kontrol edildi ve tarihe göre uyarıya gerek yok,
gece yarısı geçildiğinde ise uyarı tarihine denk geliyor diyelim ve belge açık durumda. Bu durumda dosya açık olduğunda herhangi bir tetikleme olmayacaktı. Bu nedenle kod tetikleyicisi olarak sürekli kullanılan H sütunu seçildi.

Umarım yeterince açıklayıcı ve doğru anlatabilmişimdir.

Syg,

YUSUF44 · 14 Mart 2022

Bu kısmı güzel anlatmışsınız. Kodun çalışması için dosyanın neresinde nasıl bir değişiklik olmalı? Yani ben dosyada ne yapmalıyım ki kodun çalışıp çalışmadığını görebileyim?

fledermaus · 14 Mart 2022

YUSUF44' Alıntı:
Bu kısmı güzel anlatmışsınız. Kodun çalışması için dosyanın neresinde nasıl bir değişiklik olmalı? Yani ben dosyada ne yapmalıyım ki kodun çalışıp çalışmadığını görebileyim?

Merhaba,

K3 hücresini, son sayfadaki herhangi bir bakım saat aralığına denk getirerek deneyebilirsiniz.

Mesela en yakın saat 3542:00. Herhangi bir ay sayfasının H sütununa cihazın 65 saat çalıştığını varsayarak 65:00 yazarsanız K3 hücresi artarak 3542:28 değerini vererek MAINTENANCE MONITORING sayfasındaki E7:E8 hücre aralıklarında saat aralıklarına denk gelecek ve aynı satırdaki uyarı bilgileri gösterecektir.

Bunu diğer aralıklar içinde deneyebilirsiniz. Mesela 65:00 yerine 251:00 yazarsanız bu sefer E7:E8 aralığındaki değerlere denk gelerek yine uyarı verecektir.

Tarihe dayalı uyarı denemeyi ise yine MAINTENANCE MONITORING sayfasındaki tarihlerden birinin alt sınırını bugünün tarihi yaptıktan sonra herhangi bir ay sayfasını açarsanız tarihe dayalı uyarı gelecektir.

Syg,

YUSUF44 · 15 Mart 2022

Merhaba.

Aşağıdaki gibi dener misiniz?

PHP:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And ActiveSheet.[A3].Interior.Pattern = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            If Not Mesaj = Empty Then
                MsgBox Mesaj, vbCritical
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    ActiveSheet.[A3].Interior.Pattern = xlNone
                Else
                    ActiveSheet.[A3].Interior.Color = vbRed
                End If
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And ActiveSheet.[A4].Interior.Pattern = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                If Not Mesaj = Empty Then
                    MsgBox Mesaj, vbCritical
                    sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                    If sor = vbYes Then
                        ActiveSheet.[A4].Interior.Pattern = xlNone
                    Else
                        ActiveSheet.[A4].Interior.Color = vbRed
                    End If
                End If
            End If
        End If
    Next i
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
    
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And ActiveSheet.[A3].Interior.Pattern = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            If Not Mesaj = Empty Then
                MsgBox Mesaj, vbCritical
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    ActiveSheet.[A3].Interior.Color = vbRed
                Else
                    ActiveSheet.[A3].Interior.Pattern = xlNone
                End If
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And ActiveSheet.[A4].Interior.Pattern = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If Not Mesaj = Empty Then
                    MsgBox Mesaj, vbCritical
                    If sor = vbYes Then
                        ActiveSheet.[A4].Interior.Color = vbRed
                    Else
                        ActiveSheet.[A4].Interior.Pattern = xlNone
                    End If
                End If
            End If
        End If
    Next i
End Sub

fledermaus · 16 Mart 2022

YUSUF44' Alıntı:

Merhaba.

Aşağıdaki gibi dener misiniz?

PHP:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And ActiveSheet.[A3].Interior.Pattern = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            If Not Mesaj = Empty Then
                MsgBox Mesaj, vbCritical
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    ActiveSheet.[A3].Interior.Pattern = xlNone
                Else
                    ActiveSheet.[A3].Interior.Color = vbRed
                End If
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And ActiveSheet.[A4].Interior.Pattern = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                If Not Mesaj = Empty Then
                    MsgBox Mesaj, vbCritical
                    sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                    If sor = vbYes Then
                        ActiveSheet.[A4].Interior.Pattern = xlNone
                    Else
                        ActiveSheet.[A4].Interior.Color = vbRed
                    End If
                End If
            End If
        End If
    Next i
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Name = "MAINTENANCE MONITORING" Or _
        ActiveSheet.Name = "REPORT-1" Or _
        ActiveSheet.Name = "REPORT-2" Then Exit Sub
    If IsError(Range("K3")) Then Exit Sub
   
    If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub
    Zaman = Range("K3").Value
    Set uyari = Sheets("MAINTENANCE MONITORING")
    For i = 2 To uyari.Cells(Rows.Count, 2).End(3).Row 'UBound(Veri)
        If uyari.Cells(i, 5) <= Date And uyari.Cells(i, 6) >= Date And ActiveSheet.[A3].Interior.Pattern = xlNone Then
            Mesaj = Mesaj & vbLf & vbLf & "-- TARİH UYARISI:" & vbLf & uyari.Cells(i, 2) _
                    & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
            If Not Mesaj = Empty Then
                MsgBox Mesaj, vbCritical
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If sor = vbYes Then
                    ActiveSheet.[A3].Interior.Color = vbRed
                Else
                    ActiveSheet.[A3].Interior.Pattern = xlNone
                End If
            End If
        Else
            If uyari.Cells(i, 6) >= Zaman And uyari.Cells(i, 5) <= Zaman And ActiveSheet.[A4].Interior.Pattern = xlNone Then
                Mesaj = Mesaj & vbLf & vbLf & "-- SAAT UYARISI:" & vbLf & uyari.Cells(i, 2) _
                        & Chr(10) & uyari.Cells(i, 3) & Chr(10) & uyari.Cells(i, 4)
                sor = MsgBox("Tekrar uyarı almak istiyor musunuz?", vbYesNo)
                If Not Mesaj = Empty Then
                    MsgBox Mesaj, vbCritical
                    If sor = vbYes Then
                        ActiveSheet.[A4].Interior.Color = vbRed
                    Else
                        ActiveSheet.[A4].Interior.Pattern = xlNone
                    End If
                End If
            End If
        End If
    Next i
End Sub

Merhaba,

Çalışmadı hocam. Nedenini anlayamadım açıkcası.

Syg,

YUSUF44 · 16 Mart 2022

Ekli dosyayı inceleyiniz. Dosyada her sayfanın A3 ve A4 hücreleri renklendirilerek/rengi silinerek uyarı alınıp alınmayacağı kaydediliyor ve o hücrelerin renk durumuna göre uyarı çıkıyor ya da çıkmıyor.

Soru Makro Bazlı Uyarı Mesajlarında "Uyarıyı Almak İstemiyorsanız Evet/Hayır" Mesajı Ekleme

fledermaus

Ekli dosyalar

fledermaus

fledermaus

fledermaus

YUSUF44

Destek Ekibi

fledermaus

fledermaus

fledermaus

YUSUF44

Destek Ekibi

fledermaus

Ekli dosyalar

YUSUF44

Destek Ekibi

fledermaus

YUSUF44

Destek Ekibi

fledermaus

YUSUF44

Destek Ekibi

fledermaus

YUSUF44

Destek Ekibi

fledermaus

YUSUF44

Destek Ekibi

Ekli dosyalar