Stok Risk Uyarı Mesajı

[mehmetkoca]

Değerli arkadaşlar ekteki dosyada depo stoklarını tutuyorum.Burada yapmak istediğim ,ANA EKRAN sayfasında stok çıkışı işlemi yaparken ,eğer o ürün stok sayfasında riskli durumda ise ekranda ,"dikkat stok riskli durumdadır şeklinde msgbox uyarısı vermesi.Msgbox içeriğinde ürünün adı yazarsa daha güzel olur.
Yardımlarınız için teşekkür ederim.

Saygılarımla...

 

[ExcelF1]

Kodlarınıza aşağıdaki kırmızı bölümü ekleyerek deneyin.

Sub Aktar_Çıkış()
If Sheets("STOK").Columns(3).Find(Sheets("ANA EKRAN").Range("I9")).Offset(0, 7).Value = "EVET" Then _
MsgBox "Dikkat, Stok Riskli Durumdadır"
b = MsgBox("Yine de aktarım yapmak istiyor musunuz ?", vbYesNo)
If b = vbNo Then Exit Sub
ss = Sheets("ÇIKIŞ").[A65536].End(3).Row + 1
With Sheets("ÇIKIŞ")
.Cells(ss, 1).Value = ss - 3
.Cells(ss, 2).Value = Sheets("ANA EKRAN").Cells(4, 9).Value
.Cells(ss, 3).Value = Sheets("ANA EKRAN").Cells(5, 9).Value
.Cells(ss, 4).Value = Sheets("ANA EKRAN").Cells(6, 9).Value
.Cells(ss, 5).Value = Sheets("ANA EKRAN").Cells(7, 9).Value
.Cells(ss, 6).Value = Sheets("ANA EKRAN").Cells(8, 9).Value
.Cells(ss, 7).Value = Sheets("ANA EKRAN").Cells(9, 9).Value
.Cells(ss, 8).Value = Sheets("ANA EKRAN").Cells(10, 9).Value
.Cells(ss, 9).Value = Sheets("ANA EKRAN").Cells(10, 11).Value
.Cells(ss, 10).Value = Sheets("ANA EKRAN").Cells(11, 9).Value
.Cells(ss, 11).Value = Sheets("ANA EKRAN").Cells(12, 9).Value
MsgBox "AKTARIM GERÇEKLEŞTİ ", vbInformation, "Bilgi"
End With
End Sub

 

[mehmetkoca]

Sayın ExcelF1;
Ellerinize sağlık.Verdiğiniz kodu denedim çalışıyor.Yalnız stok riskli durumda değilkende aktarırken
"Yine de aktarım yapmak istiyor musunuz?" diye soruyor.Eğer stok riskli değilse aktarım yaparken bu uyarı çıkmazsa daha güzel olacak.
Yardımınız için teşekkür ederim.

 

[ExcelF1]

Kodlarınızı aşağıdaki şekilde revize ederek deneyiniz.

Sub Aktar_Çıkış()
On Error GoTo hata
If Sheets("STOK").Columns(3).Find(Sheets("ANA EKRAN").Range("I9")).Offset(0, 7).Value = "EVET" Then
MsgBox "Dikkat, Stok Riskli Durumdadır"
b = MsgBox("Yine de aktarım yapmak istiyor musunuz ?", vbYesNo)
If b = vbNo Then Exit Sub
End If
ss = Sheets("ÇIKIŞ").[A65536].End(3).Row + 1
With Sheets("ÇIKIŞ")
    .Cells(ss, 1).Value = ss - 3
    .Cells(ss, 2).Value = Sheets("ANA EKRAN").Cells(4, 9).Value
    .Cells(ss, 3).Value = Sheets("ANA EKRAN").Cells(5, 9).Value
    .Cells(ss, 4).Value = Sheets("ANA EKRAN").Cells(6, 9).Value
    .Cells(ss, 5).Value = Sheets("ANA EKRAN").Cells(7, 9).Value
    .Cells(ss, 6).Value = Sheets("ANA EKRAN").Cells(8, 9).Value
    .Cells(ss, 7).Value = Sheets("ANA EKRAN").Cells(9, 9).Value
    .Cells(ss, 8).Value = Sheets("ANA EKRAN").Cells(10, 9).Value
    .Cells(ss, 9).Value = Sheets("ANA EKRAN").Cells(10, 11).Value
    .Cells(ss, 10).Value = Sheets("ANA EKRAN").Cells(11, 9).Value
    .Cells(ss, 11).Value = Sheets("ANA EKRAN").Cells(12, 9).Value
    MsgBox "AKTARIM GERÇEKLEŞTİ :)", vbInformation, "Bilgi"
    End With
GoTo 10
hata:
MsgBox "Malzeme Adı Hatalı. Lütfen kontrol ediniz."
10
End Sub

 

[mehmetkoca]

Üstad yardımların için teşekkürler.Sorun çözülmüştür.Teşekkür eder saygılarımı sunarım