uyarı verme

[sescizi]

Arkadaşlar çalıştığım büyük bir dosya var bir çok dosyaya linkli ama bazen linkler update olmuyor yada linkler değişmiş olabiliyor. Dosyanın başka bir yerinde de kontrol edebileceğim hücreler var. Bu hücrelerin 0 olması gerekiyor. Eğer 0 değilse dosyayı açtığımda bununlar ilgili bir uyarı görmem mümkün mü yada "conditional formating" den (koşullu biçimlendirme) den bütün sheetin rengini falan değiştirsin mesela olabilir mi. Yani kontrol ettiğim ve 0 olmasını istediğim yer diyelim Z90 dan Z120 ye kadar gidiyor. Sayfayı ilk açtığımda yada bunu bilmeyen başkaları açtığında yanlış rakamlara bakmasın diye bir uyarı olmalı. ve ilk açıldığında A1 görülmeli bu yüzdne Z90 ı göremeyeceğim. Yada Z90 da kontrol olduğunu bilmeyen biri Z90 a yapacağım uyarıyı koşullu biçmlendirmeyi göremeyecek.Ve A1 den Z90 da kadar bütün hücreler dolu. Böyle bir uyarıyı yapabilir miyiz. Makrolu ve makrosuz iki uyarıya da ihtiyacım var aslında.

 

[Orion1]

Merhaba.
Aşağıdaki kodu çalışma sayfasının (Sayfa1'in) kod sayfasına yazın .

Private Sub Worksheet_Activate()
If Range("Z90") <> "" And Range("Z90").Value = 0 Then
    MsgBox "Dikkat !! Z90 H&#252;cresinde 0 De&#287;eri Var..!!", vbOKOnly
End If
End Sub

Aşağıdaki koduda Boş bir modüle yazın Z90 hücresinde 0 değeri varsa sizi uyaracaktır.

Sub Auto_Open()
Sheets("Sayfa1").Select
If Range("Z90") <> "" And Range("Z90").Value = 0 Then
    MsgBox "Dikkat !! Z90 H&#252;cresinde 0 De&#287;eri Var..!!", vbOKOnly
End If
End Sub

 

[Orion1]

Merhaba.
Örnek dosyayı inceleyiniz.
Z91:Z120 aralığında 0 dan başka bir değer olduğunda A1:Z90 aralığı Hücre dolgu rengi kırmızı , Fontların rengi ise sarı oluyor.
Kodlar ise şöyledir.
Boş bir modül açınız ve Aşağıdaki kodları yapıştırınız.
Sayfa1 isimli sayfa olduğu varsayılmıştır.

Sub Auto_Open()
Dim i As Byte
Sheets("Sayfa1").Select
Range("A1").Select
For i = 91 To 120
    If Cells(i, "Z").Value <> 0 Then
        Range("A1:Z90").Interior.ColorIndex = 3
        Range("A1:Z90").Font.ColorIndex = 6
        Exit Sub
    End If
Next
Range("A1:Z90").Interior.ColorIndex = xlNone
Range("A1:Z90").Font.ColorIndex = 0
End Sub

Sayfa1 in kod sayfasına Aşağıdaki kodları yapıştırınız.

Private Sub Worksheet_Activate()
Dim i As Byte
For i = 91 To 120
    If Cells(i, "Z").Value <> 0 Then
        Range("A1:Z90").Interior.ColorIndex = 3
        Range("A1:Z90").Font.ColorIndex = 6
        Exit Sub
    End If
Next
Range("A1:Z90").Interior.ColorIndex = xlNone
Range("A1:Z90").Font.ColorIndex = 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Byte
If Intersect(Target, [Z91:Z120]) Is Nothing Then Exit Sub
On Error GoTo hata
If Target.Value <> 0 Then
    Range("A1:Z90").Interior.ColorIndex = 3
    Range("A1:Z90").Font.ColorIndex = 6
    Else
    Range("A1:Z90").Interior.ColorIndex = xlNone
    Range("A1:Z90").Font.ColorIndex = 0
End If
For i = 91 To 120
    If Cells(i, "Z").Value <> 0 Then
        Range("A1:Z90").Interior.ColorIndex = 3
        Range("A1:Z90").Font.ColorIndex = 6
        Exit Sub
    End If
Next
Range("A1:Z90").Interior.ColorIndex = xlNone
Range("A1:Z90").Font.ColorIndex = 0

hata:
End Sub

 

[sescizi]

Sezar, Çok Tşk. 2. örnek dosyan çalıştı ama bu format değişikliği yerine sadece ekrana uyarı verse olabilir mi. Renkler değişmesin yani sadece ekranda linkleri güncelleyin diye uyarı verirse daha mantıklı olacak. yardımcı olursan çok sevinirim. Şimdiden Tşk tekrar.

Aklına makrosuz bir yol da geliyor mu ?

 

[Orion1]

Aşağıdaki kodları dağa önce yazmış olduğunuz Sub Autpen Prosederünün içindeki kodları silerek yapıştırın.

Sub Auto_Open()
Dim i As Byte
Sheets("Sayfa1").Select
Range("A1").Select
For i = 91 To 120
    If Cells(i, "Z").Value <> 0 Then
        MsgBox "L &#304; N K L E R &#304;   G &#220; N C E L L E Y &#304; N &#304; Z ...!!!", vbOKOnly, Application.UserName
        Exit Sub
    End If
Next
End Sub

Sayfa1 in kod sayfasındaki kodları silin onun yerine aşağıdaki kodları yazın.

Private Sub Worksheet_Activate()
Dim i As Byte
For i = 91 To 120
    If Cells(i, "Z").Value <> 0 Then
        MsgBox "L &#304; N K L E R &#304;   G &#220; N C E L L E Y &#304; N &#304; Z ...!!!", vbOKOnly, Application.UserName
        Exit Sub
    End If
Next
End Sub

---------------------------------------------------------------------------------------------
Formül ile yapmak için ise Aşağıdaki formülü kullanabilirsiniz.

=E&#286;ER(E&#286;ERSAY(Z91:Z120;"<>0")>0;"L&#304;NKLER&#304; G&#220;NCELLEY&#304;N&#304;Z&#8230;!!!";"")

 

[sescizi]

Uyarı Verme

Sezar çok teşekkürler gerçekten desteğin için ama maalesef ben codları kopyalamama rağmen olmadı. Bir örnek dosya gönderiyorum. Biraz değiştirdim. M kolonunun 0 larını çek ediyor ve M kolonunda formul var. Yani eğer M1:M12 sıfır değilse makroda uyarı verecek. Rica etsem gönderdiğim örnek dosyada yapar mısın.

 

[Orion1]

Merhaba.
Ekli dosyayı inceleyiniz.A1 hücresine yazdığım formül ilede sorunuza cevap verdim.Hem formül hemde makro ile sorunu çözdüm.İyi çalışmalar.
Makroların çalışabilmesi için makroları etkinleştirmeyi unutmayınız.

 

[sescizi]

Tşk

Çok çok teşekkürler emeğin için. Ellerine ve aklına sağlık..

 

[Orion1]

Rica ederim.
İyi çalışmalar.