dolgu rengi kırmızı olunca dosyayı kaydetme

[nunu446]

Merhaba. Bana excel dosyasında hücrede kırmızı renk dolgu olduğu zaman dosyayı kaydetmek istediğimde ekrana bir userform çıkıp, userformda " fiyat yanlış, aksi takdirde kaydetmek mümkün değil " yazısı çıksın ve dosyayı kaydetmeyi engellesin - bu lazım. Bunu nasıl yapabilirim?

 

[Korhan Ayhan]

Hangi hücrede?
Renkler elle mi uygulandı? Yoksa koşullu biçimlendirme ile mi uygulandı?

 

[nunu446]

Hangi hücrede?
Renkler elle mi uygulandı? Yoksa koşullu biçimlendirme ile mi uygulandı?

Hangi hücrede - her hangi bir hücrede;
Renkler elle uygulandı.

 

[Korhan Ayhan]

Kontrolün kolay olması açısından hücre adresi sormuştum.

Excel sayfasının bütün hücrelerini işlem almak çok mantıklı değildir.

Rengi uyguladığınız sütun bellidir sanırım.

 

[nunu446]

Kontrolün kolay olması açısından hücre adresi sormuştum.

Excel sayfasının bütün hücrelerini işlem almak çok mantıklı değildir.

Rengi uyguladığınız sütun bellidir sanırım.

E sütunu ve bu arada yanlış belirtmişim - hücreler koşullu biçimlendirme ile renklendirildi.

 

[Korhan Ayhan]

Dosyanızın ThisWorkbook bölümüne aşağıdaki kodu uygulayıp deneyiniz.

Sayfa adını ve hücre aralığını kendinize göre düzenlersiniz.

Option Explicit
Dim Kontrol As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ThisWorkbook.Workbook_BeforeSave(True, False)
    Cancel = Kontrol
End Sub

Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Sayfa As Worksheet, Veri As Range
    
    Kontrol = False
    
    For Each Sayfa In ThisWorkbook.Worksheets
        For Each Veri In Sayfa.Range("E1:E1000")
            If Veri.DisplayFormat.Interior.ColorIndex = 3 Then
                MsgBox "Fiyat yanlış, bu nedenle kaydetmek mümkün değil!", vbCritical
                Cancel = True
                Kontrol = True
                Exit Sub
            End If
        Next
    Next
End Sub

 

[YUSUF44]

Sorunun çözümüyle ilgili değil ama sanki "Fiyat yanlış, aksi taktirde kaydetmek mümkün değil!" ifadesi Türkçemize uygun değil gibi.

"Fiyat yanlış, bu nedenle kaydetmek mümkün değil!" olsa daha iyi olmaz mı?

 

[nunu446]

Dosyanızın ThisWorkbook bölümüne aşağıdaki kodu uygulayıp deneyiniz.

Sayfa adını ve hücre aralığını kendinize göre düzenlersiniz.

Option Explicit
Dim Kontrol As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ThisWorkbook.Workbook_BeforeSave(True, False)
    Cancel = Kontrol
End Sub

Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Veri As Range
   
    Kontrol = False
   
    For Each Veri In Sheets("Sheet1").Range("E1:E1000")
        If Veri.DisplayFormat.Interior.ColorIndex = 3 Then
            MsgBox "Fiyat yanlış, aksi taktirde kaydetmek mümkün değil!", vbCritical
            Cancel = True
            Kontrol = True
            Exit Sub
        End If
    Next
End Sub

Cevabınız için teşekkür ederim, çok işime yaradı.

 

[nunu446]

Dosyanızın ThisWorkbook bölümüne aşağıdaki kodu uygulayıp deneyiniz.

Sayfa adını ve hücre aralığını kendinize göre düzenlersiniz.

Option Explicit
Dim Kontrol As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ThisWorkbook.Workbook_BeforeSave(True, False)
    Cancel = Kontrol
End Sub

Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim Veri As Range
  
    Kontrol = False
  
    For Each Veri In Sheets("Sheet1").Range("E1:E1000")
        If Veri.DisplayFormat.Interior.ColorIndex = 3 Then
            MsgBox "Fiyat yanlış, aksi taktirde kaydetmek mümkün değil!", vbCritical
            Cancel = True
            Kontrol = True
            Exit Sub
        End If
    Next
End Sub

Hocam bu kısmı bütün excel kitabın sayfalarına nasıl uygulaya biliriz? Yanı bütün sayfalarda aynı anda çalışsın.

İndir Screenshot 2021 153539

Dosyayı indir Screenshot 2021 153539

dosya.co

 

[Korhan Ayhan]

Sayfa döngüsünü de ekledim.

Ek olarak Yusuf beyin önerisine göre mesajı revize ettim.

Üstte ki mesajımdan kodun son halini tekrar deneyiniz.

 

[nunu446]

Sayfa döngüsünü de ekledim.

Ek olarak Yusuf beyin önerisine göre mesajı revize ettim.

Üstte ki mesajımdan kodun son halini tekrar deneyiniz.

Çok sağolun. Teşekkür ederim.