ARAYA MESAJ KUTUSU yardım

[Schuba]

arkadaşlar ekli olan kodun arasına
kodun içinde kırmızı harflerle belirttiğim gibi bir mgsbox ' a ihtiyacım var
kodu belirttiğm gibi düzenliyecek bir arkadaş varsa çok sevinirim..

Sub YENİ_DATA_KAYDI()

Dim hücre As Range

If WorksheetFunction.CountBlank(Range("C9")) > 0 Or WorksheetFunction.CountBlank(Range("C11")) > 0 _
    Or WorksheetFunction.CountBlank(Range("C17")) > 0 Or WorksheetFunction.CountBlank(Range("C22")) > 0 _
    Or WorksheetFunction.CountBlank(Range("I12")) > 0 Or WorksheetFunction.CountBlank(Range("K9")) > 0 Then
    MsgBox "LÜTFEN VERİ GİRİŞİ'NİN ZORUNLU OLDUĞU ALANLARI DOLDURUNUZ!", vbCritical
    For Each hücre In Range("C9, C11, C17, C22, I12, K9")
        If hücre = "" Then
            hücre.Select
            GoTo 10
        End If
    Next

[COLOR="Red"]ARKADAŞLAR  KOD BURAYA KADAR YAPTIĞI İŞLEMİ YAPTIKTAN SONRA 

*GİDİCEK ("V37") HÜCRESİNİ KONTROL EDİCEK  EĞER HÜCRE DEĞERİ 1000 TL DEN KÜÇÜKSE 
* MESAJ KUTUSU ÇIKICAK VE MESAJ KUTUSUNDA ("GİRDİĞİNİZ TUTAR ÇOK DÜŞÜK BU ŞEKİLDE KAYDETMEK İSTİYORMUSUNUZ ") DİYEYİCEK VE ALTINDA İKİ SEÇENEK ÇIKICAK 
EVET - HAYIR  DİYE  ..

*HAYIR'I  TIKLARSAM AŞAĞIDAKİ KODLARIMIN GERİ KALANI  DEVAM ETMİYİCEK GİDİP TUTARI DÜZELTMEM İÇİN ("V37") HÜCRESİNDE BEKİLİYİCEK

*EVET'İ  TIKLARSAM MEVCUT OLAN AŞAĞIDAKİ KODLAR DEVAM EDİP KAYDINI TAMAMLIYACAK[/COLOR]


Else
Sheets("BAKIM TAKİP").Select
    ActiveSheet.Unprotect "1122"
    Application.Calculation = xlManual
    Selection.AutoFilter
    Set S1 = Sheets("BAKIM TAKİP")
    Set S2 = Sheets("müşteri carisi")
    With S1
         X = .[b50000].End(3).Row + 1
        .Cells(X, 2) = [C24] + 1
        .Cells(X, 3) = S2.[C9]
        .Cells(X, 4) = S2.[I9]
        .Cells(X, 6) = S2.[C11]
        .Cells(X, 7) = S2.[C12]
        .Cells(X, 8) = S2.[C13]
        .Cells(X, 9) = S2.[C14]
        .Cells(X, 10) = S2.[C17]
        .Cells(X, 11) = S2.[F17]
        .Cells(X, 12) = S2.[C18]
        .Cells(X, 13) = S2.[F18]
        .Cells(X, 14) = S2.[C19]
        .Cells(X, 15) = S2.[F19]
        .Cells(X, 16) = S2.[C20]
        .Cells(X, 17) = S2.[F20]
        .Cells(X, 18) = S2.[I11]
        .Cells(X, 19) = S2.[I12]
        .Cells(X, 20) = S2.[I13]
        .Cells(X, 21) = S2.[I14]
        .Cells(X, 22) = S2.[I15]
        .Cells(X, 23) = S2.[I16]
        .Cells(X, 24) = S2.[C22]
        .Cells(X, 27) = S2.[L21]
        .Cells(X, 28) = S2.[P21]
        .Cells(X, 29) = S2.[K9]
        .Cells(X, 30) = S2.[P9]
    End With
    Sheets("BAKIM TAKİP").Select
    Range("B24:AE24").Select
    Selection.AutoFilter
    Application.Calculation = xlAutomatic
ActiveSheet.Protect "1122", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True, AllowUsingPivotTables:=True
Range("B25").Select
    Selection.End(xlDown).Select
     MsgBox "YENİ DATA KAYDI TAMAMLANDI"
End If
10:
End Sub

 

[Asri]

aşağıdaki kodu ekleyiniz

 If Range("V37").Value < 1000 Then
   a = MsgBox("GİRDİĞİNİZ TUTAR ÇOK DÜŞÜK BU ŞEKİLDE KAYDETMEK İSTİYORMUSUNUZ?", vbExclamation + vbYesNo, "Uyarı!")
   If a = vbNo Then
      Range("V37").Select
      Exit Sub
   End If
 End If

 

[Schuba]

hocam vallah bu formda sizde olmasanız ne yapıcaz bilmiyorum

çok güzel oldu teşekkür ederim..

 

[Asri]

hocam vallah bu formda sizde olmasanız ne yapıcaz bilmiyorum

çok güzel oldu teşekkür ederim..

Estğ. arada sıra yaptığım bir katkı. Demekki hep size denk gelmiş