• DİKKAT

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

Kayıt güncellerken combobox koşulu oluşturma

Katılım
15 Ocak 2013
Mesajlar
116
Excel Vers. ve Dili
2010 Turkce
Merhaba arkadaşlar

ekteki dosyamda bilgi mevcuttur. Yapmak istediğim comboboxtan bir veri seçtiğimde kayıt güncelleme yaparken yüzdeler kısmındaki veriyi kontrol edip uyarı vermesini istiyorum. örnek dosyam ekte.

teşekkür ederim.

( güncel dosya ektedir. 15.07.2013)
 

Ekli dosyalar

Son düzenleme:
Aşağıdaki kodu deneyiniz.

Kod:
Private Sub CommandButton5_Click()
    If ComboBox1 = "Vazgeçildi" Or ComboBox1 = "Siparişte" Then
        If ComboBox2.ListIndex < 0 Then
            MsgBox "Yüzde alanı için değer seçimi yapınız!", vbCritical
            Exit Sub
        End If
    Else
        For a = 1 To 19
        '1 den 19'e kadar textbox'lar döngü kuruluyor
        If TextBox1.Value = "" Then
        TextBox1.SetFocus
        MsgBox ("Kat No Alanı Boş Bırakılamaz. Lütfen Kat Numarası Giriniz."), vbInformation, "A++"
        Exit Sub
        End If
        If TextBox2.Value = "" Then
        TextBox2.SetFocus
        MsgBox ("Raf No Alanı Boş Bırakılamaz. Lütfen Raf Numarası Giriniz."), vbInformation, "A++"
        Exit Sub
        End If
        If TextBox3.Value = "" Then
        TextBox3.SetFocus
        MsgBox ("Tarih Alanı Boş Bırakılamaz. Lütfen Tarih Giriniz."), vbInformation, "A++"
        Exit Sub
        'işlem bitiriliyor
        End If
        'if sonlandırılıyor
        Next
        
        ts = ListBox1.ListIndex + 4
        cevap = MsgBox("Satış verilerini güncellemek istediğinize emin misiniz?", vbInformation + vbYesNo, "A++")
        If cevap = vbNo Then Exit Sub
        Sheets("Btck").Select
        ListBox1.RowSource = ""
        Cells(ts, "A") = TextBox1.Value
        Cells(ts, "B") = TextBox2.Value
        Cells(ts, "C") = TextBox3.Value
        Cells(ts, "J") = TextBox4.Value
        Cells(ts, "L") = TextBox5.Value
        Cells(ts, "N") = TextBox6.Value
        Cells(ts, "T") = TextBox7.Value
        Cells(ts, "P") = TextBox8.Value
        Cells(ts, "R") = TextBox9.Value
        Cells(ts, "AF") = TextBox10.Value
        Cells(ts, "AD") = TextBox11.Value
        Cells(ts, "V") = TextBox12.Value
        Cells(ts, "AL") = TextBox13.Value
        Cells(ts, "AH") = TextBox14.Value
        Cells(ts, "AJ") = TextBox15.Value
        Cells(ts, "Z") = TextBox16.Value
        Cells(ts, "AN") = TextBox17.Value
        Cells(ts, "X") = TextBox18.Value
        Cells(ts, "AB") = TextBox19.Value
        Cells(ts, "H") = TextBox20.Value
        Cells(ts, "D") = TextBox21.Value
        Cells(ts, "G") = TextBox22.Value
        Cells(ts, "F") = ComboBox1.Value
        Cells(ts, "AP") = ComboBox2.Value
        UserForm_Initialize
    End If
End Sub
 
Aşağıdaki kodu deneyiniz.

Kod:
Private Sub CommandButton5_Click()
    If ComboBox1 = "Vazgeçildi" Or ComboBox1 = "Siparişte" Then
        If ComboBox2.ListIndex < 0 Then
            MsgBox "Yüzde alanı için değer seçimi yapınız!", vbCritical
            Exit Sub
        End If
    Else
        For a = 1 To 19
        '1 den 19'e kadar textbox'lar döngü kuruluyor
        If TextBox1.Value = "" Then
        TextBox1.SetFocus
        MsgBox ("Kat No Alanı Boş Bırakılamaz. Lütfen Kat Numarası Giriniz."), vbInformation, "A++"
        Exit Sub
        End If
        If TextBox2.Value = "" Then
        TextBox2.SetFocus
        MsgBox ("Raf No Alanı Boş Bırakılamaz. Lütfen Raf Numarası Giriniz."), vbInformation, "A++"
        Exit Sub
        End If
        If TextBox3.Value = "" Then
        TextBox3.SetFocus
        MsgBox ("Tarih Alanı Boş Bırakılamaz. Lütfen Tarih Giriniz."), vbInformation, "A++"
        Exit Sub
        'işlem bitiriliyor
        End If
        'if sonlandırılıyor
        Next
        
        ts = ListBox1.ListIndex + 4
        cevap = MsgBox("Satış verilerini güncellemek istediğinize emin misiniz?", vbInformation + vbYesNo, "A++")
        If cevap = vbNo Then Exit Sub
        Sheets("Btck").Select
        ListBox1.RowSource = ""
        Cells(ts, "A") = TextBox1.Value
        Cells(ts, "B") = TextBox2.Value
        Cells(ts, "C") = TextBox3.Value
        Cells(ts, "J") = TextBox4.Value
        Cells(ts, "L") = TextBox5.Value
        Cells(ts, "N") = TextBox6.Value
        Cells(ts, "T") = TextBox7.Value
        Cells(ts, "P") = TextBox8.Value
        Cells(ts, "R") = TextBox9.Value
        Cells(ts, "AF") = TextBox10.Value
        Cells(ts, "AD") = TextBox11.Value
        Cells(ts, "V") = TextBox12.Value
        Cells(ts, "AL") = TextBox13.Value
        Cells(ts, "AH") = TextBox14.Value
        Cells(ts, "AJ") = TextBox15.Value
        Cells(ts, "Z") = TextBox16.Value
        Cells(ts, "AN") = TextBox17.Value
        Cells(ts, "X") = TextBox18.Value
        Cells(ts, "AB") = TextBox19.Value
        Cells(ts, "H") = TextBox20.Value
        Cells(ts, "D") = TextBox21.Value
        Cells(ts, "G") = TextBox22.Value
        Cells(ts, "F") = ComboBox1.Value
        Cells(ts, "AP") = ComboBox2.Value
        UserForm_Initialize
    End If
End Sub


hocam emeğinze sağlık teşekkür ederim. Bu kodu denedim uyarı mekanizması çalışıyor fakat bu seferde güncelleme işlemini yapmıyor. Uyarıya tamam dedikten sonra yüzde verisini seçiyorum güncelle diyorum hiç bir işlem yapmıyor veriler boş görünüyor döngü yerlerini değiştirdim uyarıda yes no şeklinde yaptım yine olmadı kayıt yapmadı. Kontrol edebilir misiniz? teşekkür ederim.
yukarıdaki ekte düzenledim dosyayı.
 
Kod:
Private Sub CommandButton5_Click()
    If ComboBox1 = "Vazgeçildi" Or ComboBox1 = "Siparişte" Then
        If ComboBox2.ListIndex < 0 Then
            MsgBox "Yüzde alanı için değer seçimi yapınız!", vbCritical
            Exit Sub
        End If
[COLOR="red"]goto 99[/COLOR]
    Else

[COLOR="Red"]99[/COLOR]
        For a = 1 To 19
        '1 den 19'e kadar textbox'lar döngü kuruluyor
        If TextBox1.Value = "" Then
        TextBox1.SetFocus
        MsgBox ("Kat No Alanı Boş Bırakılamaz. Lütfen Kat Numarası Giriniz."), vbInformation, "A++"
        Exit Sub
        End If
        If TextBox2.Value = "" Then
        TextBox2.SetFocus
        MsgBox ("Raf No Alanı Boş Bırakılamaz. Lütfen Raf Numarası Giriniz."), vbInformation, "A++"
        Exit Sub
        End If
        If TextBox3.Value = "" Then
        TextBox3.SetFocus
        MsgBox ("Tarih Alanı Boş Bırakılamaz. Lütfen Tarih Giriniz."), vbInformation, "A++"
        Exit Sub
        'işlem bitiriliyor
        End If
        'if sonlandırılıyor
        Next
        
        ts = ListBox1.ListIndex + 4
        cevap = MsgBox("Satış verilerini güncellemek istediğinize emin misiniz?", vbInformation + vbYesNo, "A++")
        If cevap = vbNo Then Exit Sub
        Sheets("Btck").Select
        ListBox1.RowSource = ""
        Cells(ts, "A") = TextBox1.Value
        Cells(ts, "B") = TextBox2.Value
        Cells(ts, "C") = TextBox3.Value
        Cells(ts, "J") = TextBox4.Value
        Cells(ts, "L") = TextBox5.Value
        Cells(ts, "N") = TextBox6.Value
        Cells(ts, "T") = TextBox7.Value
        Cells(ts, "P") = TextBox8.Value
        Cells(ts, "R") = TextBox9.Value
        Cells(ts, "AF") = TextBox10.Value
        Cells(ts, "AD") = TextBox11.Value
        Cells(ts, "V") = TextBox12.Value
        Cells(ts, "AL") = TextBox13.Value
        Cells(ts, "AH") = TextBox14.Value
        Cells(ts, "AJ") = TextBox15.Value
        Cells(ts, "Z") = TextBox16.Value
        Cells(ts, "AN") = TextBox17.Value
        Cells(ts, "X") = TextBox18.Value
        Cells(ts, "AB") = TextBox19.Value
        Cells(ts, "H") = TextBox20.Value
        Cells(ts, "D") = TextBox21.Value
        Cells(ts, "G") = TextBox22.Value
        Cells(ts, "F") = ComboBox1.Value
        Cells(ts, "AP") = ComboBox2.Value
        UserForm_Initialize
    End If
End Sub
hocam emeğinze sağlık teşekkür ederim. Bu kodu denedim uyarı mekanizması çalışıyor fakat bu seferde güncelleme işlemini yapmıyor. Uyarıya tamam dedikten sonra yüzde verisini seçiyorum güncelle diyorum hiç bir işlem yapmıyor veriler boş görünüyor döngü yerlerini değiştirdim uyarıda yes no şeklinde yaptım yine olmadı kayıt yapmadı. Kontrol edebilir misiniz? teşekkür ederim.
yukarıdaki ekte düzenledim dosyayı.



hocam tamamdır düzelttim sorunu çözdüm. Kırmızı ile işaretledim :) :) teşekkür ederim emeğin için tekrar. :) herkes faydalansın diye ilk mesaja güncel dosyayı ekledim.
 
Geri
Üst