Worksheet_SelectionChange

[ybilgin]

Alış fiyatının değiştirilmesini engellediğimiz gibi
Satış fiyatınında değiştirilmesini engellemek istiyorum.
Ama bir türlü beceremedim.


Bu makroyu yapmak istememizdeki neden şudur.
Komplike olan bir Veri girişi ekranımız var. Bu ekranki bilgiler Veri tabanına aktarılıyor.
İhtiyaç duyuldukça Veritabanından çağrılan bu verilerin üzerinde değişiklikler yapılıyor.

Tüm veride değişiklik yapılabilsin Ancak "Alış Fiyatıyla" "Satış fiyatında" Değişiklik Yapılamasın istiyorum.
Yapmaya çalıştığım mantık şöyle.
Alış fiyatını nın bulunduğu C2 Hücresini kontrol ediyoruz. Eğer veri yoksa İlk kez veri girilmesine müsaade ediyorum.
uyarı veriyor.
Alış fiyatının değiştirilmesini engellediğimiz gibi
Satış fiyatınında değiştirilmesini engellemek istiyorum.
Ama bir türlü beceremedim.

workbook.selectionchange olayına bağlayarak ALIŞ FİYATI nın değiştirilmesini engelledim
ikinci bir hücredeki değerin değiştirilmemesini sağlayamıyorum.
Alış fiyatındaki gibi SATIŞ FİYATI nında değiştirilmesini beceremedim.
Selection.change olayına iki hücreyi kontrol ettirtemedim.

ÖRNEK ekli dosyadadır.

Yardımcı olabilecek arkadaşlara çok teşekkür ederim.

 

[Ömer]

Merhaba,

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
[COLOR=blue]If Intersect(Target, [C2:D2]) Is Nothing Then Exit Sub[/COLOR]
 
If [COLOR=blue]Target[/COLOR] <> "" Then
   Range("B2").Select
   MsgBox ("ALIŞ Rakamını Değiştiremezsiniz! Kayıtlara Bu Şekilde Geçti.")
 
Else:
   MsgBox ("Dikkat! ALIŞ Tutarı Değiştirilemeyecek Rakamı Doğru Yazın!")
 
End If
 
End Sub

Bu şekilde deneyiniz..

.

 

[ybilgin]

If Intersect(Target, [C22]) Is Nothing Then Exit Sub

Hedef Hücre değilde BİRLEŞTİRİLMİŞ HÜCRELER
olduğunda işe yaramıyor.

Örnek dosya.

 

[Ömer]

Hedef Hücre değilde BİRLEŞTİRİLMİŞ HÜCRELER
olduğunda işe yaramıyor.

Bu tür detayları ilk mesajınızda belirtmenizi rica ederim.

Bu şekilde deneyiniz..

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
[COLOR=blue]If Intersect(Target, [P2,P20]) Is Nothing Then Exit Sub[/COLOR]
 
[COLOR=blue]deg = Split(Target.Address, ":")(0)[/COLOR]
 
If [COLOR=blue]Range(deg)[/COLOR] <> "" Then
   Range("B2").Select
   MsgBox ("ALIŞ Rakamını Değiştiremezsiniz! Kayıtlara Bu Şekilde Geçti.")
 
Else:
   MsgBox ("Dikkat! ALIŞ Tutarı Değiştirilemeyecek Rakamı Doğru Yazın!")
 
End If
 
End Sub

.

 

[ybilgin]

Allah sizden razı olsun.
Çoook teşekkür ediyorum
elleriniz dert görmesin.
Çoook harika oldu. Çook büyük bir zahmetten kurtardınız beni.
Size çoook ama çook duacı olacağım.
Tekrar teşekkürler Ömer bey.