Onay verildikten sonra textbox değerine göre diğer sayfaları kontrol edebilmek.

Katılım
14 Mart 2020
Mesajlar
58
Excel Vers. ve Dili
2010
Öncelik ile hayırlı ramazanlar arkadaşlar ,

Şöyle bir sorum olacak benim 10 ayrı sayfam var biri tutarsızlık çözüm ve 7 de alan sayfası var örneğin S5A S5C VE SC11 gibi. şimdi ben burada bu sayfalarda tutarsızlık girişi yaptıktan sonra hem bu sayfa da sonrada tutarsızlık sayfasında kaydettiriyorum. Tutarsızlık sayfasında ise çözüm butonu var ona tıkladığımda ise tutarsızlık çözümü yapıldığında çözüm sayfasına kaydettiriyorum. Buraya kadar sıkıntısız çalıştırıyorum. Buradan sonrasında kaldım çözüm sayfasında çözüm onay formu var formu doldurunca onay butonuna tıklayınca o çözümün satır olarak tamamen silinmesini istiyorum , red tuşuna basınca da aynı tutarsızlığın hangi alanda kayıt oldu ise olanda o satırın kırmızı olmasını istiyorum.

Çok karmaşık gibi ama olabilirliği var mı acaba. Şimdiden çok teşekkür ederim.

Kod:
Private Sub kaydet_Click()
    Dim sira As Long
    Dim syf As Variant
    For Each syf In Array("TUTARSIZLIK", ComboBox1.Text)
        With Worksheets(syf)
             sira = WorksheetFunction.CountA(.Range("A:A")) + 1
            .Cells(sira, 1) = WorksheetFunction.Max(.Range("A:A")) + 1
            .Cells(sira, 2) = tb_tarih.Text
            .Cells(sira, 3) = tb_id.Text
            .Cells(sira, 4) = tb_kod.Text
            .Cells(sira, 5) = tb_ad.Text
            .Cells(sira, 6) = tb_pro.Text
            .Cells(sira, 7) = ComboBox1.Value
            .Cells(sira, 8) = tb_alansor.Text
            .Cells(sira, 9) = ComboBox2.Value
            .Cells(sira, 10) = tb_acik.Text
        End With
    Next
    MsgBox "Uygunsuzluk girişi başarılı bir şekilde sağlandı.", vbInformation, "Medipol Sağlık Grubu"
    
           tb_tarih.Text = CDate(Date)
           tb_id.Text = ""
           tb_kod.Text = ""
           tb_ad.Text = ""
           tb_pro.Text = ""
           ComboBox1.Value = ""
           tb_alansor.Text = ""
           ComboBox2.Value = ""
           tb_acik.Text = ""
    
    
    
End Sub
'TUTARSIZLIK SAYFASINA VE ALAN SAYFASINA BU KOD İLE KAYIT YAPIYORUM'
Private Sub kaydet_Click()
    Dim sira As Long
    If com_sira.Value = "" Then
        MsgBox "Çözümlemek istediğiniz Tutarsızlığı Şeçmeniz Gerekli", vbCritical, "Sıra Numarası Seçilmeli!"
        com_sira.SetFocus
    End If


    Dim x As Long
    Dim sor As Byte
    sor = MsgBox("Tutarsızlık Çözüm İşlemleriniz Kaydedilecek. Onaylıyor Musunuz?", vbYesNo + vbQuestion + vbDefaultButton1, "TUTARSIZLIK ONAYI")
    If sor = 7 Then Exit Sub
    For x = 2 To 10000
    If Sheets("ÇÖZÜM").Range("A" & x).Value = "" Then Exit For
    Next
        
        Sheets("ÇÖZÜM").Range("A" & x).Value = tb_tarih.Value
        Sheets("ÇÖZÜM").Range("B" & x).Value = tb_id.Value
        Sheets("ÇÖZÜM").Range("C" & x).Value = tb_kod.Value
        Sheets("ÇÖZÜM").Range("D" & x).Value = tb_adi.Value
        Sheets("ÇÖZÜM").Range("E" & x).Value = tb_pro.Value
        Sheets("ÇÖZÜM").Range("F" & x).Value = tb_alan.Value
        Sheets("ÇÖZÜM").Range("G" & x).Value = tb_alansor.Value
        Sheets("ÇÖZÜM").Range("H" & x).Value = TextBox9.Value
        Sheets("ÇÖZÜM").Range("I" & x).Value = tb_pro.Value
        Sheets("ÇÖZÜM").Range("K" & x).Value = TextBox7.Value
        Sheets("ÇÖZÜM").Range("O" & x).Value = TextBox8.Value
        Sheets("ÇÖZÜM").Range("N" & x).Value = tb_acik.Value
        
    If OptionButton1.Value = True Then
        Sheets("ÇÖZÜM").Range("J" & x).Value = "EVET"
    Else
        Sheets("ÇÖZÜM").Range("L" & x).Value = "EVET"
    End If
        
        MsgBox "Yapılan İşlemler Kaydedilmiştir.", vbInformation, "KAYIT BAŞARILI"

tb_tarih.Value = ""
tb_id.Value = ""
tb_kod.Value = ""
tb_adi.Value = ""
tb_alan.Value = ""
tb_alansor.Value = ""
TextBox9.Value = ""
TextBox7.Value = ""
TextBox8.Value = ""
tb_acik.Value = ""
 
End Sub
'ÇÖZÜM SAYFASINADA KAYDI BU ŞEKİL SAĞLIYORUM'
Private Sub kaydeton_Click()
'Dim siras As Long
    'If onay_por.Value = "" Then
          '  MsgBox "Hasta Protokolü ve Alan Belirlenmeli.", vbCritical, "Protokol ve Alan Belirlenmeli!"
        'onay_pro.SetFocus
    'End If


    Dim x As Long
    Dim soro As Byte
    soro = MsgBox("Onay İşlemleriniz Kaydedilecek. Onaylıyor Musunuz?", vbYesNo + vbQuestion + vbDefaultButton1, "ÇÖZÜM ONAYI")
    If soro = 7 Then Exit Sub
    For x = 2 To 10000
    If Sheets("ÇÖZÜM").Range("o" & x).Value = "" Then Exit For
    Next
          
        
    If OptionButton1.Value = True Then
        
        Sheets("ÇÖZÜM").Range("o" & x).Value = "ONAY VERİLDİ."
    Else
        Sheets("ÇÖZÜM").Range("o" & x).Value = "RED EDİLDİ."
    End If
        
        MsgBox "Yapılan İşlemler Kaydedilmiştir.", vbInformation, "KAYIT BAŞARILI"


End Sub  'ONAY BUTONUMU DA BU ŞEKİL KURGULADIM AMA OLMADI '
 
Üst