• DİKKAT

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

Mgsbox evet hayır

  • Konbuyu başlatan Konbuyu başlatan Schuba
  • Başlangıç tarihi Başlangıç tarihi
Katılım
27 Ocak 2016
Mesajlar
170
Excel Vers. ve Dili
microsoft 365 family türkçe
arkadaşlar şöyle bir koda ihtiyacım var

(müşteri carisi) diye form şeklinde bir sayfam var ve bu formadaki bilgileri (müşteri listesi) diye oluşturduğum başka bir sayfaya aktaran bir makro butonum var

benim istediğim ise bu şuanda çalışan makromun içine bir Mgsbox eklemek istiyorum

Mgsbox ın yapacağı iş şöle olucak

butona tıkladığımda (müşteri carisi) sayfasındaki ("V37") hücresini kontrol edicek eğer hücrenin içeriğindeki rakam 1000 tl nin altında ise
bir mesaj kutusu çıkacak
SATIŞ TUTARI ÇOK DÜŞÜK BU ŞEKİLDE KAYDETMEK İSTİYORMUSUNUZ !! diye ve mesaj kutusunun altında iki tane seçenek olucak
EVET - HAYIR diye

EVET' i tıklarsam mevcut çalışan makrom devam edicek
HAYIR'ı tıklarsam mevcut kodum çalışmayı durdurup ("V37") hücresinde beklicek


konuyla alakalı yardımcı olacak arkadaşlara şimdiden teşekkür ederim
 
Merhaba, şöyle bir kod işinizi görür mü?

Kod:
Sub Kontrol()
If Sheets("müşteri carisi").Range("V37") < 1000 Then
If MsgBox("Satış tutarı çok düşük, bu şekilde kaydetmek istiyor musunuz?", vbYesNo, "KONTROL") = vbYes Then
ActiveWorkbook.Save
MsgBox ("Dosya kaydedildi.")
Else
Sheets("müşteri carisi").Select
Range("V37").Select
End If
End If
End Sub
 
Son düzenleme:
hocam gönderdiğiniz kod tek başına çalışıyor fakat ben bunu ekli olan kodumun arasında kullanmak istiyorum nasıl olacağını bilemedim

ekli kodumun arasında nasıl çalışacağını belirtiyoırum düzenliye bilirseniz sevini

Kod:
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"]HOCAM 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 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
rim
 
Merhaba, küçük bir örnek hazırlayıp gönderirseniz, yardımcı olacak arkadaşlar çıkacaktır.
 
Geri
Üst