• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Fatura tutarı 4.999 Tl den büyük ise uyarı versin.

relaxim

Altın Üye
Katılım
30 Ağustos 2009
Mesajlar
589
Excel Vers. ve Dili
LTSC Pro Plus 2024 Türkçe
Değerli üstadlar aşağıdaki kodlar ile faturayı başka sayfaya kaydediyorum. Fatura tutarı 4.999 Tl den büyük ise kaydetmek istediğinize emin misiniz diye sorsun. Kaydetmekten vazgeçebileyim.

Private Sub CommandButton1_Click()
Sayfa2.PrintPreview
Dim s1 As Worksheet: Set s1 = Sheets("FATURA")
Dim s2 As Worksheet: Set s2 = Sheets("Fatura Kayıtları")
Dim son2 As Long: son2 = s2.Range("A65500").End(xlUp).Row + 1
Say = WorksheetFunction.CountIf(s2.Range("E2:E" & son2), s1.Cells(4, 8))
If Say > 0 Then MsgBox "Bu fatura daha önce kaydedilmiştir...", vbInformation, "ASKM": Exit Sub

For i = 11 To 35
If s1.Cells(i, 1) <> "" Then
s2.Cells(son2, 1).Value = s1.Cells(2, 1).Value
s2.Cells(son2, 2).Value = s1.Cells(6, 6).Value
s2.Cells(son2, 3).Value = s1.Cells(8, 6).Value
s2.Cells(son2, 4).Value = s1.Cells(4, 6).Value
s2.Cells(son2, 5).Value = s1.Cells(4, 8).Value 'fatura no
s2.Cells(son2, 6).Value = s1.Cells(i, 1).Value
s2.Cells(son2, 7).Value = s1.Cells(i, 2).Value
s2.Cells(son2, 8).Value = s1.Cells(i, 3).Value
s2.Cells(son2, 9).Value = s1.Cells(i, 4).Value
s2.Cells(son2, 10).Value = s1.Cells(i, 5).Value
s2.Cells(son2, 11).Value = s1.Cells(i, 6).Value
s2.Cells(son2, 12).Value = Round(s2.Cells(son2, 11) * 0.18, 2)
s2.Cells(son2, 13).Value = s2.Cells(son2, 11) + s2.Cells(son2, 12) 'fatura tutarı burası
End If
son2 = son2 + 1
Next i

MsgBox "Bu Fatura kaydedilmiştir.", vbInformation, "soylu": Exit Sub


End Sub
 
Merhaba.
Aşağıdaki kodları For i = 11 To 35 satırından önceki satıra kopyalayın.
Kod:
if s2.Cells(son2, 11) + s2.Cells(son2, 12) >"4.999"
if msgbox ("Fatura toplamı 4,999'dan fazla, yinede kaydetmek istiyor musnuz?",vbyesno) = vbno then exit sub
end if
 
Dalgalikur hızlı dönüşünüz için teşekkür ederim.
if s2.Cells(son2, 11) + s2.Cells(son2, 12) >"4.999" bu satır kırmızı renge döndü.
 
if s2.Cells(son2, 11) + s2.Cells(son2, 12) >"4.999" silin yerine aşağıdaki kodu kopyalayın
if s2.Cells(son2, 11) + s2.Cells(son2, 12) >4.999

Eğer yine hata verirse
4.999 yerine 4,999 yazın.
 
Dalgalikur merhaba, . , ve işaretsiz denedim.
212440
 
Yukarıda da söylediğim gibi oradaki virgül yerine nokta olmalı yani kod satırı şöyle olacak.
Kod:
if s2.Cells(son2, 11) + s2.Cells(son2, 12) >4.999

Yine de olmazsa dosyanızı ekleyin bakayım.
 
Şimdi çıkmam lazım. Akşam örnek ekleyeceğim. Teşekkür ederim.
 
Merhabalar,
Örnek dosyayı ekledim. Fatura sayfasındaki kaydet butonuna bastığımızda Fatura tutarı 4999 TL den büyükse uyarı versin ve kaydetmesin.

İlgileneceklere şimdiden teşekkür ederim.
 

Ekli dosyalar

Hata veren satırın sonunda "Then" diye bir ifade olmasi gerekiyor , eğer başlamış ama ise eklenmemış.
 
EmrExcel16 merhaba, dediğiniz gibi yapınca hata vermedi. Ancak uyarı da vermedi.
 
Merhaba sn dalgalikur'un uyarilarini dikkate alarak denemeleri yaptiniz mi.
 
Hepsini yaptım hatta value = 4999 olarak ta denedim.
 
Kodun yerini değiştirdim uyarı verdi. Ancak hayır seçmeme rağmen kayıt yapıyor. Son durum aşağıdaki şekilde.

Private Sub CommandButton1_Click()
Sayfa2.PrintPreview


Dim s1 As Worksheet: Set s1 = Sheets("FATURA")
Dim s2 As Worksheet: Set s2 = Sheets("Fatura Kayıtları")
Dim son2 As Long: son2 = s2.Range("A65500").End(xlUp).Row + 1
Say = WorksheetFunction.CountIf(s2.Range("E2:E" & son2), s1.Cells(4, 8))
If Say > 0 Then MsgBox "Bu fatura daha önce kaydedilmiştir...", vbInformation, "ASKM": Exit Sub

For i = 11 To 35
If s1.Cells(i, 1) <> "" Then
s2.Cells(son2, 1).Value = s1.Cells(2, 1).Value
s2.Cells(son2, 2).Value = s1.Cells(6, 6).Value
s2.Cells(son2, 3).Value = s1.Cells(8, 6).Value
s2.Cells(son2, 4).Value = s1.Cells(4, 6).Value
s2.Cells(son2, 5).Value = s1.Cells(4, 8).Value 'fatura no
s2.Cells(son2, 6).Value = s1.Cells(i, 1).Value
s2.Cells(son2, 7).Value = s1.Cells(i, 2).Value
s2.Cells(son2, 8).Value = s1.Cells(i, 3).Value
s2.Cells(son2, 9).Value = s1.Cells(i, 4).Value
s2.Cells(son2, 10).Value = s1.Cells(i, 5).Value
s2.Cells(son2, 11).Value = s1.Cells(i, 6).Value
s2.Cells(son2, 12).Value = Round(s2.Cells(son2, 11) * 0.18, 2)
s2.Cells(son2, 13).Value = s2.Cells(son2, 11) + s2.Cells(son2, 12)

If s2.Cells(son2, 11) + s2.Cells(son2, 12) > 4999 Then
If MsgBox("Fatura toplamı 4,999'dan fazla, yinede kaydetmek istiyor musnuz?", vbYesNo) = vbNo Then Exit Sub
End If

End If
son2 = son2 + 1
Next i

MsgBox "Bu Fatura kaydedilmiştir.", vbInformation, "soylu": Exit Sub


End Sub
 
Kodu aşağıdaki şekilde değiştirince istediğim oldu. İlgilenen arkadaşlara teşekkürler.


Private Sub CommandButton1_Click()
Sayfa2.PrintPreview

Dim s1 As Worksheet: Set s1 = Sheets("FATURA")
Dim s2 As Worksheet: Set s2 = Sheets("Fatura Kayıtları")
Dim son2 As Long: son2 = s2.Range("A65500").End(xlUp).Row + 1
If Cells(39, 6) > 4999 Then 'Buradaki değer fatura sayfasındaki kdv li tutar
If MsgBox("Fatura toplamı 4.999'dan fazla, yinede kaydetmek istiyor musnuz?", vbYesNo) = vbNo Then Exit Sub
End If

Say = WorksheetFunction.CountIf(s2.Range("E2:E" & son2), s1.Cells(4, 8))
If Say > 0 Then MsgBox "Bu fatura daha önce kaydedilmiştir...", vbInformation, "ASKM": Exit Sub

For i = 11 To 35
If s1.Cells(i, 1) <> "" Then
s2.Cells(son2, 1).Value = s1.Cells(2, 1).Value
s2.Cells(son2, 2).Value = s1.Cells(6, 6).Value
s2.Cells(son2, 3).Value = s1.Cells(8, 6).Value
s2.Cells(son2, 4).Value = s1.Cells(4, 6).Value
s2.Cells(son2, 5).Value = s1.Cells(4, 8).Value 'fatura no
s2.Cells(son2, 6).Value = s1.Cells(i, 1).Value
s2.Cells(son2, 7).Value = s1.Cells(i, 2).Value
s2.Cells(son2, 8).Value = s1.Cells(i, 3).Value
s2.Cells(son2, 9).Value = s1.Cells(i, 4).Value
s2.Cells(son2, 10).Value = s1.Cells(i, 5).Value
s2.Cells(son2, 11).Value = s1.Cells(i, 6).Value
s2.Cells(son2, 12).Value = Round(s2.Cells(son2, 11) * 0.18, 2)
s2.Cells(son2, 13).Value = s2.Cells(son2, 11) + s2.Cells(son2, 12)


End If
son2 = son2 + 1
Next i

MsgBox "Bu Fatura kaydedilmiştir.", vbInformation, "soylu": Exit Sub


End Sub
 
Geri
Üst