VBA Bilgi Sorgulama Kutucuk

[syakar80]

Merhabalar;

Okul için bir excel çalışma kitabımda VBA ile ilgili yardımınıza ihtiyacım var, şimdiden ilgilenen arkadaşlara teşekkür ediyorum.

Örnek çalışma kitabını mesajıma ekledim, kısaca bahsetmek gerekirse çalışma kitabımda 2 çalışma sayfası bulunmakta bunlardan biri bilgilerin olduğu kısım diğeri ise sorgulama ve değişiklik yapılması gerek kısım.

Sizden istediğim
1) 2. kısımda sorgulama yaptıktan sonra bilgi sayfasından verilerin getirilmesi.
2) Dönem kısımlarının yanındaki kutucukları işaretleyip kaydet tuşuna bastığımda bilgi sayfasında ilgili dönem kısımlarında "YAPTI" ibaresinin yazılması.
3) Yeni sorgu yapmak için TEMİZLE butonuna bastığımda sarı hücrelerin temizlenmesi.

Not: Şablon taslak aşamasında olması nedeniyle önerilerinize açığım "... şu şekilde olması daha iyi olur" gibi.

Saygılarımla.

Link:
Örnek

 

[ÖmerBey]

Merhaba,
Herhangi bir projeyi tasarlarken kodlama kısmını en sona bırakmanızı tavsiye ediyorum. Önce şablonunuza son halini verip daha sonra kodlamaya başlayınız. Zira şablona ekleyeceğiniz bir tek hücre bile kodlamanın değişmesine sebep olacaktır.
Yüklediğiniz dosya için örnek kodlama aşağıdadır.
Birinci bölümü modül 1 içerisine ikinci bölümü sorgulama sayfasının kod bölümüne uygulayıp deneyiniz.

Public kayit As Range, B As Worksheet, S As Worksheet
Sub Sorgula()
Dim i As Byte, j As Byte
Set B = Sheets("Bilgi")
Set S = Sheets("sorgulama")
sicil = S.Range("B2").Value
If WorksheetFunction.CountIf(B.Range("B:B"), sicil) = 0 Then
    MsgBox "Kayıt bulunamadı.", vbCritical
Else
    Set kayit = B.Range("B:B").Find(sicil, , , xlWhole)
    For i = 2 To 6
        S.Cells(i + 2, "B").Value = kayit.Offset(0, i)
    Next
    For j = 1 To 3
        ActiveSheet.OLEObjects("CheckBox" & j).Object.Value = IIf(S.Cells(j + 5, "B").Value = "YAPTI", True, False)
        S.Cells(j + 5, "D").Value = S.Cells(j + 5, "B").Value
    Next
End If
End Sub

Sub Kaydet()
If kayit Is Nothing Then
    MsgBox "Önce kişi sorgulaması yapınız.", vbCritical
Else
    kayit.Offset(0, 2).Value = S.Range("B4")
    kayit.Offset(0, 3).Value = S.Range("B5")
    kayit.Offset(0, 4).Value = S.Range("D6")
    kayit.Offset(0, 5).Value = S.Range("D7")
    kayit.Offset(0, 6).Value = S.Range("D8")
    MsgBox "Kayıt işlemi gerçekleşti."
End If
End Sub

Sub Temizle()
Application.EnableEvents = False
Set kayit = Nothing
For i = 1 To 3
    ActiveSheet.OLEObjects("CheckBox" & i).Object.Value = False
Next
Range("B2:B8,D6:D8").ClearContents
Application.EnableEvents = True
End Sub

Private Sub CheckBox1_Click()
Range("D6").Value = IIf(CheckBox1.Value, "YAPTI", "YAPMADI")
End Sub

Private Sub CheckBox2_Click()
Range("D7").Value = IIf(CheckBox2.Value, "YAPTI", "YAPMADI")
End Sub

Private Sub CheckBox3_Click()
Range("D8").Value = IIf(CheckBox3.Value, "YAPTI", "YAPMADI")
End Sub

Bunların dışında, dosyada değişiklik yapmayı düşünüyorsanız değişiklikleri tamamlamadan kodlarla ilgili güncelleme istememenizi rica ediyorum.
İyi çalışmalar...