otomatik mesajbox çıkması

[endymion]

Merhaba arkadaşlar, forumda istediğim türden bir cevap bulamadım, ekte sorunumu yazdım çok sayfalı bir stok dosyam var. Belirli bir sayı altına düştüğünde uyarı verecek kod nasıl olmalı. ??? şimdiden teşekkürler.

 

[Ömer]

Merhaba,

Bu işlemi veri doğrulama ile yapabilirsiniz.

C2: D4 aralığını fare ilen seçin ve veri doğrulama/izin verilen bölümünden/ özel seçeneğini seçerek,

=$F$2>30

yazın ve daha sonra "hata uyarı" bölümünden uyarıyı seçip hata uyarı bölümüne istediğiniz metni yazarak tamam ile işlemi bitirin.

 

[endymion]

cevap çok işime yaradı ama bir iki küçük ekleme yapmamız mümkün mü ? örneğin; sağda kullandığımız adetleri aşağıya doğru çektiğimizde sayı düşse de uyarı vermiyor, ikinci olarak;eğer tek tek elle yazarken uyarı verdiyse ok ya da tamam seçeneği çıkmıyor ve yazdığımız veriyi yazmamıza izin vermiyor. bunları nasıl çözebiliriz??

 

[asi_kral]

Merhaba
Sorunuzu dosya üzerinde ayrıntılı bir şekilde anlatır mısınız_?

 

[endymion]

dosyayı düzenleyip ekliyorum. tekrar bakabilir misiniz. nerede hata yapıyorum??

 

[asi_kral]

Merhaba
Öncelikle doğrulamaları iptal edin.
Sonra sayfanın kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SR As Variant
Application.EnableEvents = False
If Intersect(Target, Range("D2:D4")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
If Range("F2") < 30 Then
SR = MsgBox("30'un Altına Düştü" & vbLf _
& "Devam Etmek İstiyor Musunuz", vbYesNo, "HATA")
If SR = vbNo Then
Target.ClearContents
Target.Select
End If: End If
Application.EnableEvents = True
End Sub

 

[endymion]

soruyu orjinal dosyaya göre sormayınca hatalı sonuç veriyor haliyle. acaba tekrar bakabilirmisiniz? dosyayı güncelledim, orjinaline uygun hale getirdim.

 

[asi_kral]

Merhaba
D36 hücresindeki formülü

=BAĞ_DEĞ_DOLU_SAY(D2:D35)

Bununla değiştirin.
Kodu ise bununla

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim SR As Variant
Application.EnableEvents = False
If Intersect(Target, Range("D2:D35")) Is Nothing Then _
Application.EnableEvents = True: Exit Sub
If Range("F2") < 30 Then
SR = MsgBox("30'un Altına Düştü" & vbLf _
& "Devam Etmek İstiyor Musunuz", vbYesNo, "HATA")
If SR = vbNo Then
Target.ClearContents
Target.Select
End If: End If
Application.EnableEvents = True
End Sub