• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

kapatırken tüm sheetlerde belirli bir şartı kontrol etmek

E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim msj As Integer
If Cancel = True Then Exit Sub
If Application.Sum(Range("c23:t23")) > 0 And Range("b23") = "" Or Application.Sum(Range("c24:t24")) > 0 And Range("b24") = "" Then
     Range("b23").Select
     msj = MsgBox("Proje Kapsamı Bilgilerinde İlini Yazmadığın Yer Var Gibi... " _
     & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
     If msj = vbYes Then Cancel = True
End If

If Cancel = True Then Exit Sub
If Range("f14") = "ONAYLI" And Range("j14") = "" Then
Range("j14").Select
     msj = MsgBox("Onay Tarihini Yazmadın!!! ... " _
     & "Yazmak İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
     If msj = vbYes Then Cancel = True
End If

For a = 36 To 68
If Cancel = True Then Exit Sub
If IsEmpty(Cells(a, "H")) And Not IsEmpty(Cells(a, "C")) Then
Range("c36").Select
     msj = MsgBox("Köprü Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
     & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
     If msj = vbYes Then Cancel = True
End If
Next a


For b = 74 To 100
If Cancel = True Then Exit Sub
If IsEmpty(Cells(b, "H")) And Not IsEmpty(Cells(b, "C")) Then
Range("c74").Select
     msj = MsgBox("Tünel Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
     & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
     If msj = vbYes Then Cancel = True
End If
Next b


For c = 106 To 145
If Cancel = True Then Exit Sub
If IsEmpty(Cells(c, "H")) And Not IsEmpty(Cells(c, "C")) Then
Range("c106").Select
     msj = MsgBox("Kavşak Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
     & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
     If msj = vbYes Then Cancel = True
End If
Next c

For D = 15 To 21
If Cancel = True Then Exit Sub
If Cells(D, "bg") = "yok" Then
Range("B23").Select
     msj = MsgBox("PROJE KAPSAMINDAKİ İLLER İLE YAPI ELEMANLARININ İLLERİ UYUŞMUYOR. FARKLI BİR İL GİRMİŞSİN!!! " _
     & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
     If msj = vbYes Then Cancel = True
End If
Next D

End Sub

yazdığım kod exceli kapatırken sadece baktığım çalışma sayfasını kontrol ediyor.
exceli kapatırken tüm sheetlerin aynı şartlar altında kontrol edilmesi ve uyarı vermesini nasıl sağlayabilirim. (tüm sayfaların düzeni aynı)
burada tabi çok sayfa olursa ve çoğunda hata varsa ne olacak sorusu oluşuyor sanırım. msgbox lara belki sekme isimleri yazdırılabilir. şu, bu, o sekmelerinde .......... gibi.
Tabi bu dediklerim yapılabilir mi bilmiyorum. cevap alabilirsem sevinirim.
 
Merhaba.

Kod aşağıdaki gibi olmalı.
Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim msj As Integer
    Dim a, b, c, D
    Dim syf As Worksheet
    
    For Each syf In ThisWorkbook.Worksheets
    If Cancel = True Then Exit Sub
    If Application.Sum(syf.Range("c23:t23")) > 0 And syf.Range("b23") = "" Or Application.Sum(syf.Range("c24:t24")) > 0 And syf.Range("b24") = "" Then
         syf.Range("b23").Select
         msj = MsgBox("Proje Kapsamı Bilgilerinde İlini Yazmadığın Yer Var Gibi... " _
         & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
         If msj = vbYes Then Cancel = True
    End If
    
    If Cancel = True Then Exit Sub
    If syf.Range("f14") = "ONAYLI" And syf.Range("j14") = "" Then
        syf.Range("j14").Select
         msj = MsgBox("Onay Tarihini Yazmadın!!! ... " _
         & "Yazmak İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
         If msj = vbYes Then Cancel = True
    End If
    
    For a = 36 To 68
    If Cancel = True Then Exit Sub
    If IsEmpty(syf.Cells(a, "H")) And Not IsEmpty(syf.Cells(a, "C")) Then
    syf.Range("c36").Select
         msj = MsgBox("Köprü Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
         & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
         If msj = vbYes Then Cancel = True
    End If
    Next a
    
    
    For b = 74 To 100
    If Cancel = True Then Exit Sub
    If IsEmpty(syf.Cells(b, "H")) And Not IsEmpty(syf.Cells(b, "C")) Then
    syf.Range("c74").Select
         msj = MsgBox("Tünel Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
         & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
         If msj = vbYes Then Cancel = True
    End If
    Next b
    
    
    For c = 106 To 145
    If Cancel = True Then Exit Sub
    If IsEmpty(syf.Cells(c, "H")) And Not IsEmpty(syf.Cells(c, "C")) Then
    syf.Range("c106").Select
         msj = MsgBox("Kavşak Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
         & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
         If msj = vbYes Then Cancel = True
    End If
    Next c
    
    For D = 15 To 21
    If Cancel = True Then Exit Sub
    If syf.Cells(D, "bg") = "yok" Then
    syf.Range("B23").Select
         msj = MsgBox("PROJE KAPSAMINDAKİ İLLER İLE YAPI ELEMANLARININ İLLERİ UYUŞMUYOR. FARKLI BİR İL GİRMİŞSİN!!! " _
         & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
         If msj = vbYes Then Cancel = True
    End If
    Next D
    Next syf
End Sub

Mesajlarda safa ismi çıksın istiyorsanız syf.name kullanabilirsiniz.
Örnek: msgbox syf.name & " adlı sayfada sorun var. " & syf.name & " adlı sayfada gerekli düzenlemeleri yapınız.

Bir öneri. Değişken tanımlaması yapmayı unutmayınız ve değişken isimlerine anlamlı bir isim veriniz.
a, b, c, D şeklinde değişkenler kullanmışsınız ve hatta tanımlama yapmamışsınız.
Mutlak tanımlama yapın (sadece bir harf "a" yerine Dim SatirSayisi as long - gibi) ve mutlaka değişkenlere anlamlı bir isim verin ki, kodlarınız için yardım istediğinizde değişkenlerin ne işe yaradığını bir bakışta anlayabilelim.
Hatta siz de belli bir zaman sonra tek bir harf ile kullandığınız değikenlerin ne işe yaradığını unutabilirsiniz.

Kolay gelsin.
 
uyarılarınızı dikkate alacağımdan emin olabilirsiniz ama sizin bu kodu yazmanız belki 5 dk, benimse sağa bak sola bak, örnek bak, oluyor mu dene derken 3 günümü alıyor. tıkandığım yerde buradan paylaş cevap bekle derken doğal olarak a mı koymuşum b mi koymuşum inanın o aşamada değilim. :)

yazdığınız kod şöyle bir sıkıntı veriyor. "range sınıfının select yöntemi başarısız" ve syf.Range("b23").Select uyarı verdiği yer.
 
"range sınıfının select yöntemi başarısız" hata mesajını aldığınız satırın bir üst satırına
syf.activate yazın.
Hata açık(aktif) olmayan bir sayfada hücre seçilemez anlamına geliyor.
Önce syf.activate ile sayfayı aktif etmelisiniz.

Kolay gelsin.
 
dalgalikur' Alıntı:
"range sınıfının select yöntemi başarısız" hata mesajını aldığınız satırın bir üst satırına
syf.activate yazın.
Hata açık(aktif) olmayan bir sayfada hücre seçilemez anlamına geliyor.
Önce syf.activate ile sayfayı aktif etmelisiniz.

Kolay gelsin.
Genişletmek için tıkla ...


konuyu kapatmadan önce bir ek daha istesem çok mu olurum. kodun başına hatalar var görmek ister misin diye bir uyarı çıksa ve evete basarsa kod normal devam etse, hayıra basarsa normal kaydet kaydetme iletişim kutusu çıksa :)

ayrıca,
emeğinize sağlık. ve yine ayrıca uslup ve tarzınız için de teşekkürler. bazen azar yiyoruz uzman arkadaşlardan. soru sormaya da korkuyoruz sonrasında. size de kolay gelsin.
 
Sorunuzu anlayamadım.
Kodun başında hata var mesajı çıkarmak saçma olmaz mı. Çünkü hata olmayabilir.

Rica ederim. Karşılıklı saygı olunca bir sorun olacağını sanmıyorum.
Bazen sorunlar sadece yanlış anlamaktan kaynaklanıyor diye düşünüyorum.

Kolay gelsin.
 
o zaman şöyle diyeyim. çok bilgi yanlışı olursa çok mesaj çıkmasını engellemek maksadı ile. ya da düzeltmeleri sonra yapacağımızı farzederek...
işlemler şu şekilde olsa

"hata kontrolü yapmak ister misiniz?"
evet ise kod devam eder
hayır ise "kaydet kaydetme iptal"

Kod: 
 secim = MsgBox("HATA KONTROLÜ YAPILSIN MI?", vbYesNo + vbCritical)
If secim = vbNo Then Cancel = False
Exit Sub  burada kodun kalan kısmı çalışmadan normal excel kaydet etme uyarısı gelecek
If secim = vbYes Then Cancel = True  bu kısımda ise kodun kalan kısmı çalışmaya devam edecek.
 
    Dim msj As Integer
    Dim a, b, c, D
    Dim syf As Worksheet
    ...
    .
    .
    .
düzenleyemedim.
 
Son düzenleme:
Kodların en başına şu kodları ekleyerek yapabilirsiniz.

Kod: 
    Dim HataKontrol As VbMsgBoxResult
    HataKontrol = MsgBox("Hata kontrolü yapmak istiyor musunuz?", vbYesNo + vbQuestion, "Hata Kontrol")
    If HataKontrol = vbYes Then Exit Sub

Yeni kodlar şöyle olacak
Kod: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim msj As Integer
    Dim a, b, c, D
    Dim syf As Worksheet
    Dim HataKontrol As VbMsgBoxResult
    HataKontrol = MsgBox("Hata kontrolü yapmak istiyor musunuz?", vbYesNo + vbQuestion, "Hata Kontrol")
    If HataKontrol = vbYes Then Exit Sub
    For Each syf In ThisWorkbook.Worksheets
    If Cancel = True Then Exit Sub
    If Application.Sum(syf.Range("c23:t23")) > 0 And syf.Range("b23") = "" Or Application.Sum(syf.Range("c24:t24")) > 0 And syf.Range("b24") = "" Then
        syf.Activate
        syf.Range("b23").Select
        msj = MsgBox("Proje Kapsamı Bilgilerinde İlini Yazmadığın Yer Var Gibi... " _
            & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
        If msj = vbYes Then Cancel = True
    End If
    
    If Cancel = True Then Exit Sub
    If syf.Range("f14") = "ONAYLI" And syf.Range("j14") = "" Then
        syf.Activate
        syf.Range("j14").Select
        msj = MsgBox("Onay Tarihini Yazmadın!!! ... " _
            & "Yazmak İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
        If msj = vbYes Then Cancel = True
    End If
    
    For a = 36 To 68
    If Cancel = True Then Exit Sub
    If IsEmpty(syf.Cells(a, "H")) And Not IsEmpty(syf.Cells(a, "C")) Then
        syf.Activate
        syf.Range("c36").Select
        msj = MsgBox("Köprü Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
            & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
        If msj = vbYes Then Cancel = True
    End If
    Next a
    
    
    For b = 74 To 100
    If Cancel = True Then Exit Sub
    If IsEmpty(syf.Cells(b, "H")) And Not IsEmpty(syf.Cells(b, "C")) Then
        syf.Activate
        syf.Range("c74").Select
        msj = MsgBox("Tünel Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
            & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
        If msj = vbYes Then Cancel = True
    End If
    Next b
    
    
    For c = 106 To 145
    If Cancel = True Then Exit Sub
    If IsEmpty(syf.Cells(c, "H")) And Not IsEmpty(syf.Cells(c, "C")) Then
        syf.Activate
        syf.Range("c106").Select
        msj = MsgBox("Kavşak Bilgilerinde İlini Yazmadığın Yer Var Gibi..." _
           & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
        If msj = vbYes Then Cancel = True
    End If
    Next c
    
    For D = 15 To 21
    If Cancel = True Then Exit Sub
    If syf.Cells(D, "bg") = "yok" Then
        syf.Activate
        syf.Range("B23").Select
        msj = MsgBox("PROJE KAPSAMINDAKİ İLLER İLE YAPI ELEMANLARININ İLLERİ UYUŞMUYOR. FARKLI BİR İL GİRMİŞSİN!!! " _
            & "Düzeltmek İster misin?", vbYesNo + vbCritical, "KONTROL ET!!!!")
            If msj = vbYes Then Cancel = True
    End If
    Next D
    Next syf
End Sub
 
teşekkürler.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst