Makro ile uyarı vermesi

[ormann]

Arkadaşlar ekteki örnek dosyamda d3 hücresine dava takip noyu girersem d7 hücresi uyarı vermesin.ancak dava takip noyu boş bırakıp direk olarak d7 hücresine veri girdiğimde bana"lütfen dava takip noyu giriniz" uyarısını vereblirmi yardımlarınızı bekliyorum saygılar

 

[AS3434]

Sayın ormann

Aşağıdaki kodları denermisiniz...Bu kodlarla direk D7 hücresine veri girin,size takip noyu soracaktır. Ben takip no yazıyorum diyorsanız 3. satırdaki kesme işaretini (Kırmızı) kaldırın...

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D7]) Is Nothing Then Exit Sub
[COLOR=red]'[/COLOR]If [d3].Value > 0 Then Exit Sub
x = InputBox(" Lütfen Dava Takip No Girin", "Takip No")
[d3].Value = x
End Sub

 

[ormann]

Sayın hocam ellerinize sağlık form sesli olarak gelebilirmi

 

[AS3434]

.
.
Üzgünüm, ses olayını bilmiyorum.....


.

 

[ormann]

Teşekkür ederim.

 

[ormann]

Sn değerli hocalarım AS3434 hocamın aşağıdaki makrosunu ekteki örnek dosyam uyarlamaya çalıştım fakat bir türlü aktar,sil.geri çağır makrolarını çalıştıramadım .benim sizden ricam ekteki örnek dosyamda bulunan suç bilgileri sayfasında d5 hücresine (sarırenkli) kişinin adını ve soayadını yazdığımda bana d5 hücresinde dava takip no yazılı değilse bana uyarı versin("Lütfen Dava Dakip No Girin") eğer yazılı ise uyarı vermesin .Sil ,aktar ,çağır makrolarını tıkladığımda bu uyarı gelmesin.Şifre:1978 dir.yardımlarınızı bekliyorum saygılar


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D10]) Is Nothing Then Exit Sub
'If [d5].Value > 0 Then Exit Sub
x = InputBox(" Lütfen Dava Takip No Girin", "Takip No")
[d5].Value = x
End Sub

 

[ormann]

Sn değerli hocalarım AS3434 hocamın aşağıdaki makrosunu yukarıdaki örnek dosyama uyarlamaya çalıştım fakat bir türlü aktar,sil.geri çağır makrolarını çalıştıramadım .benim sizden ricam yukarıdaki dosyamda bulunan suç bilgileri sayfasında d5 hücresine (sarırenkli) kişinin adını ve soayadını yazdığımda bana d5 hücresinde dava takip no yazılı değilse bana uyarı versin("Lütfen Dava Dakip No Girin") eğer yazılı ise uyarı vermesin .Sil ,aktar ,çağır makrolarını tıkladığımda bu uyarı gelmesin.Şifre:1978 dir.yardımlarınızı bekliyorum saygılar


Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D10]) Is Nothing Then Exit Sub
'If [d5].Value > 0 Then Exit Sub
x = InputBox(" Lütfen Dava Takip No Girin", "Takip No")
[d5].Value = x
End Sub

 

[AS3434]

Sayın ormann

Sil makronuzu şöyle düzenleyin... [D3: D25] aralığını aldım, gerçek aralığınız neresiyse onu yazın..

Sub sil()
[COLOR=red]Application.EnableEvents = False[/COLOR]
If MsgBox("Silmek İstediğinizden Emin misiniz???", vbYesNo) = vbNo Then Exit Sub
[d3:d25].Clear
[COLOR=red]Application.EnableEvents = True[/COLOR]
End Sub

Sadece sil makrosunda sorun olduğunu sanıyordum ama diğer makrolarınızda da sorun oluyorsa kırmızı yeri sorun olan tüm makrolarınıza uyarlayın.

 

[ormann]

sayın hocam ben dediğinizi uyarlayamadım .sizden rica etsem 6.nolu mesajımdaki dosyayı uyarlayabilirmisiniz.saygılar

 

[ormann]

sayın hocam sil ve aktarma makrolarına uyguladım.fakat çağır makrosunda çalıştıramadım

 

[ormann]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D10]) Is Nothing Then Exit Sub
'If [d5].Value > 0 Then Exit Sub
x = InputBox(" Lütfen Dava Takip No Girin", "Takip No")
[d5].Value = x


Dim s, Dosya_Yolu As String
Dosya_Yolu = ThisWorkbook.Path & "\"
Dim yer As Worksheet
Dim bul As Range
Dim sat As Integer
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Intersect(Target, Range("C3,D3,E3,F3,G3,H3")) Is Nothing Then Exit Sub
Set yer = Sheets("SUÇ KAYDI")
Set bul = yer.Cells.Find(Target, , xlValues, xlWhole)
If bul Is Nothing Then
ExecuteExcel4Macro ("SOUND.PLAY(, """ & Dosya_Yolu & "KAYIT BULUNAMADI.wav"")")
Exit Sub
Else
sat = bul.Row
End If
yer.Range("A" & sat & ":AL" & sat).Copy
Range("D5").PasteSpecial xlPasteValues, , , True
Application.CutCopyMode = False
Range("D5").Activate
End Sub




yukarıdaki çağır makrosuna ilk verdiğiniz makroyu uyarladım fakat veriler çağırılmıyo

 

[AS3434]

Sayın ormann
Dosyanız ve modülleriniz çok karışık. (Tabii bana göre)
Daha sade bir dosya üzerinden sorunuzu sorun..
Bir de Sub ile başlayan makroları Modüllere, Private Sub ile başlayan makroları Kod Sayfalarına yazarsanız daha iyi sonuç alırsınız....Bazı makrolar hem Kod Sayfasında hem de modülde var. Fazla olanları kaldırın...

 

[ormann]

sayın hocam dosyayı dediğiniz gibi ayıkladım.yalnız fazla modülleri silemedim.bilmediğim için dosyayı yeniden gönderiyorum .aşağıdaki makroyu uygulayabilrmisiniz.sil ,veri aktar,veri çağır dediğim zaman
"Lütfen Dava Takip No Girin" uyarını almamam gerekiyo.



Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D10]) Is Nothing Then Exit Sub
'If [d5].Value > 0 Then Exit Sub
x = InputBox(" Lütfen Dava Takip No Girin", "Takip No")
[d5].Value = x
End Sub