Takvim ekleme ile ilgili

[muyat]

B2 ve b100 arasındaki hücrelere
veya
d2 ve d100 arasındaki hücrelere tıklayınca takvim açılsın istiyorum.Userformdan takvim ekledim aama aşagıdaki kodu ekleyince hata veriyor
Lütfen düzeltebilir misiniz.Hata nerde


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If (Not Intersect(Target, Range("B2:B100") Or Range("D2100")) Is Nothing) Then
TAKVİM.Show
End If

End Sub

 

[turist]

If Not Intersect(Target, Range("B2:B100,D2: D100")) Is Nothing Then
veya
If Not Intersect(Target, Range("B2:B100")) Is Nothing Or Not Intersect(Target, Range("D2: D100")) Is Nothing Then
Şeklinde deneyin.

 

[muyat]

Çok Teşekkür ederim.Oldu
Peki son olarak şunu da istesem yazar mısınız.
D2100 aralıgındaki hücrelere bir tarih girince ya da ekledigim takvimle bir tarih seçince ,program otomatik olarak e2:100 deki hücreye ilgili d satırındaki tarihin 30 gün sonrasını otomatik yapıştırsın istiyorum
Yani d2 deki tarih 11.02.2019 ise e2deki tarih 30 gün sonrası olcak.
d3deki tarih 11.04.2019 ise e3 deki tarih 30 gün sonrası şeklinde

 

[turist]

Sayfa Kodu kısmına diğer kodunuzun bulunduğu yere aşağıdaki kodu uygulayıp deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D2:D100")) Is Nothing Then
If Target = "" Then
Target.Offset(0, 1) = ""
Else
Target.Offset(0, 1) = CDate(Target.Value + 30)
End If
End If
End Sub

 

[muyat]

Hocam konu ile alakalı oldugu için tekrar sorayım.şöyle bir sorunum var.
Aşagıdaki kodu yazınca takvim açılıyor fakat,burda da mesela ben bir satırı tamamen silmek istedigimde en soldaki satır numarasına tıkladıgımda satırı silemiyorum.Hemen takvim açılıyor.Çünkü satır numarasına tıkladıgımda dolayıyla b ve d'nin ilgili satırına tıkladıgım için takvim açılıyor.
Bu problemi nasıl çözebiliriz?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If (Not Intersect(Target, Range("B2:B100,D2100")) Is Nothing) Then
TAKVİM.Show
End If

End Sub

 

[turist]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If (Not Intersect(Target, Range("B2:B100,D2:D100")) Is Nothing) Then
TAKVİM.Show
End If
End Sub

şeklinde uygulayın.

 

[muyat]

hocam teşekkürler

 

[Orion1]

Bir hatırlatma.
Değişken adlarında ve userform ve nesne adlarında Türkçe karakterler kullanmayınız.
İngilizce olan bir Windows'ta hata verebilir.

 

[muyat]

Son bir istegim daha olcak sizden.
D2 ve D100 arası herhangi bir hücrenin içinde yazan tarih 03.04.2019 olsun diyelim.
Bugunkü tarihimiz 01.04.2019 bu hücre sarıya boyansın
bugunkü tarihimiz 03.04.2019 ise bu hücre yeşile boyansın
bugunkü tarih 04.04.2019 ise yani hücrenin içinde yazan tarihi geçmişse kırmızıya boyansın..
Bunu da yazar mısınız rica etsem.Basit bir hatırlatma programım var.koşullu biçimlendirme ile yapıyorum ama makro ile de yapmak istiyorum.