Öğretmen Görev Formu Düzenleme

[Ercan ÖZYURT]

Merhabalar, ekli dosyada açıklamalar mevcut. Konu ile ilgili yardım rica ediyorum.

 

[ÖmerFaruk]

1 nolu alanda yazılacak satır sayısı 5 den fazla olamıyor mu? Olursa ne olacak?

B2:B5 aralığına veri yazacak mısınız?
A19:A21 ve D19: D21 de bulunan şekillerin içine bir işlem yapacak mısınız?

 

[Ercan ÖZYURT]

1 nolu alanda yazılacak satır sayısı 5 den fazla olamıyor mu? Olursa ne olacak?

B2:B5 aralığına veri yazacak mısınız?
A19:A21 ve D19: D21 de bulunan şekillerin içine bir işlem yapacak mısınız?

Bir işletmede genelde en fazla 4-5 öğrenci çalışabiliyor. Belki şöyle olabilir; 5ten fazla olursa diğer formda çıkabilir aynı öğretmen ve işletme için ama dediğim gibi 5 satır yeterli oldu şimdiye kadar

B2:B5 aralığı çok önemli değil, zaten işletme üst orta kısma kaşe basacağı için oralar boş kalsa da olur.

A19:A21 ve D19: D21 de bulunan şekillerin içine herhangi bir işlem yapmayacağız,. O kısımlar işyerine gidildiğinde değişkenlik göstereceği için elle doldurulacak

 

[ÖmerFaruk]

İlk soruma cevap vermediniz.

 

[ÖmerFaruk]

Yeni bir soru
Görev Formu sayfasındaki 2 form birbnirinin aynısı.
Neden 2ayrı form dolduruyoruz? Print ederken 2 kopya çıkarsak olmuyor mu?
Yoksa bu iki form bir A4 kağıdına mı çıkacak?

 

[ÖmerFaruk]

Sorulara cevabınız farklı olursa revize ederiz.
Ne olur ne olmaz listeye sıralama yaptırdım. Kriterler sırasıyla, İşyeri - Öğretmen - Öğrenci şeklinde belirledim.
Kodlar aşağıda ve dosyanız ektedir

Sub GörevFormuOluştur()
Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Zaman As Double, Bul As Range, Kurumlar As Range
Dim Veri As Variant, Öğrenciler As Variant
Dim i%, k%, Say%, xSay%

    Set S1 = Worksheets("Bilgi")
    Set S2 = Worksheets("GörevFormu")
    Set Bul = S1.Cells.Find("Öğrenci Ad Soyad", , xlValues, xlWhole)
    If Bul Is Nothing Then MsgBox "Başlık satırı 'Öğrenci Adı Soyadı' bulunamadı": Exit Sub
    Son = Bul.End(xlDown).Row
    Bul.Offset(1, 0).Resize(Son - Bul.Row, 5).Sort Key1:=Bul.Offset(0, 3), Order1:=xlAscending, _
        Key2:=Bul.Offset(0, 4), Order2:=xlAscending, Key3:=Bul.Offset(0, 0), Order3:=xlAscending
    
    Veri = Bul.Offset(1, 0).Resize(Son - Bul.Row, 5).Value

    Set Kurumlar = Bul.Offset(1, 4).Resize(Son - Bul.Row, 1)
    For i = 1 To UBound(Veri, 1)
        S2.Range("B7") = Veri(i, 5)
        S2.Range("A29") = Veri(i, 4)
        S2.Range("D29") = S1.Range("B3")
        S2.Range("D31") = S1.Range("A3")
        Say = WorksheetFunction.CountIf(Kurumlar, Veri(i, 5))
        xSay = WorksheetFunction.Min(5, Say)
        S2.Range("A11:E15").ClearContents
        Öğrenciler = Bul.Offset(i, 0).Resize(Say, 3).Value
        For k = 1 To xSay
            S2.Range("A" & 10 + k) = Öğrenciler(k, 1)
            S2.Range("D" & 10 + k) = Öğrenciler(k, 2)
            S2.Range("E" & 10 + k) = Öğrenciler(k, 3)
        Next k
        S2.Range("C16") = Say
        i = i + Say - 1
        S2.Rows("1:32").Copy S2.Rows("35:66")
        'S2.PrintOut 'Print etmek için satırın başındaki ('S2.PrintOut) tek tırnağı silmeniz yeterli
    Next i
    Set Bul = Nothing: Set Kurumlar = Nothing: Set S1 = Nothing: Set S2 = Nothing
End Sub

 

[Ercan ÖZYURT]

Evet iki form birbirinin aynısı, formlar A5 boyutunda, tasarruf olsun diye iki formu bir kağıtta çıkartıyoruz.

 

[ÖmerFaruk]

Merhaba, öncelikle sorularınız özel mesajla değil de forumdan sorarsanız, benzer sorusu ya da ihtiyacı olanlar da faydalanabilir.

1. Print almayı sormuşsunuz.
Kodların içinde belirtmiştim. Kodların alttan 4 satırını buraya tekrar yapıştırıyorum. Ben printer kullanamadığım için kodları test ederken bu satırı pasif ediyorum.
Ayrıca, dosyanızda Yazdırılabilir Alan belirlemiş ve SayfaKenar ölçüleri ve formatları ayarlamıştım. Baskı önizleme yaparak görebilirsiniz.

        'S2.PrintOut 'Print etmek için satırın başındaki ('S2.PrintOut) tek tırnağı silmeniz yeterli
    Next i
    Set Bul = Nothing: Set Kurumlar = Nothing: Set S1 = Nothing: Set S2 = Nothing
End Sub

2.Her iki form tek sayfada A5 gibi çıkacak
Dosyanızda yazdırılabilir alan belirlemiş ve kenar boşluklarını ve formatları ayarlamıştım. Baskı önizleme yaparak görebilirsiniz.

3. İlave olarak ilk tarih son tarih bilgileri ve müdür isminin aşağı kaydırılması
Aşağıda kodun gösterdiğim yere veriğim yeni satırı aynen kopyalayın ve müdür ismi yazılacak D29 yazan kısmı D30 yapın.

    For i = 1 To UBound(Veri, 1)
        S2.Range("B7") = Veri(i, 5)
        S2.Range("A29") = Veri(i, 4)
        ' başlangıç bitiş tarihleri ilavesi.................................................
        S2.Range("D28") = S1.Range("B2") & " - " & S1.Range("C2")
        ' ...........................................
        S2.Range("D30") = S1.Range("B3") ' bu satırda D29 olan kısmı D30 yapacaksınız
        S2.Range("D31") = S1.Range("A3")

4. Edanur CIDIR B12 de, yani ilk onun ismi gözüküyor
#6 nolu mesajımda belirtmiştim. "Ne olur ne olmaz listeye sıralama yaptırdım. Kriterler sırasıyla, İşyeri - Öğretmen - Öğrenci şeklinde belirledim"
Formlar Öğretmenlerin isim sırasıyla, İşyeri tabanlı olarak çıkacağı için döngü ilk çalıştığında ilk form oluşuyor.
Edanur ismi yapılan sıralamada kaçıncı işyeri ise o formda çıkacaktır.

 

[Ercan ÖZYURT]

Açıklamalar için teşekkür ederim. Mesaj konusunda haklısınız, kusura bakmayın.
İşlemleri yaptım oldu çok teşekkürler. İkinci sorumu sorarken eksik bilgi vermiş olabilirim. Şöyleki; yazdırmak istediğimde döngü, ilk form için birinci işletme ve öğrenci bilgilerini, ikinci olan alttaki formda ikinci işletme ve öğrenci bilgilerini, çıktısı alınacak sonraki formda üst kısımda 3. işletme ve öğrenci bilgilerini, alttaki formda 4. işletme ve öğrenci bilgilerini ..... şeklinde çıktı almak istiyorum.

 

[ÖmerFaruk]

Kodları revize ettim. Buyrun.

Sub GörevFormuOluştur()
Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Zaman As Double, Bul As Range, Kurumlar As Range
Dim Veri As Variant, Öğrenciler As Variant, FormAlanları As Range
Dim i%, k%, Say%, xSay%

    Set S1 = Worksheets("Bilgi")
    Set S2 = Worksheets("GörevFormu")
    Set FormAlanları = S2.Range("B7:B8,A29,D28:D31,C16,A11:E15")

    Set Bul = S1.Cells.Find("Öğrenci Ad Soyad", , xlValues, xlWhole)
    If Bul Is Nothing Then MsgBox "Başlık satırı 'Öğrenci Adı Soyadı' bulunamadı": Exit Sub
    Son = Bul.End(xlDown).Row
    Bul.Offset(1, 0).Resize(Son - Bul.Row, 5).Sort Key1:=Bul.Offset(0, 3), Order1:=xlAscending, _
        Key2:=Bul.Offset(0, 4), Order2:=xlAscending, Key3:=Bul.Offset(0, 0), Order3:=xlAscending
    
    Veri = Bul.Offset(1, 0).Resize(Son - Bul.Row, 5).Value

    Set Kurumlar = Bul.Offset(1, 4).Resize(Son - Bul.Row, 1)
    FormAlanları.Offset(0, 0) = ""
    FormAlanları.Offset(34, 0) = ""
    For i = 1 To UBound(Veri, 1)
        S2.Range("B7") = Veri(i, 5)
        S2.Range("A29") = Veri(i, 4)
        S2.Range("D28") = S1.Range("B2") & " - " & S1.Range("C2")
        S2.Range("D30") = S1.Range("B3")
        S2.Range("D31") = S1.Range("A3")
        Say = WorksheetFunction.CountIf(Kurumlar, Veri(i, 5))
        xSay = WorksheetFunction.Min(5, Say)
        S2.Range("A11:E15").ClearContents
        Öğrenciler = Bul.Offset(i, 0).Resize(Say, 3).Value
        For k = 1 To xSay
            S2.Range("A" & 10 + k) = Öğrenciler(k, 1)
            S2.Range("D" & 10 + k) = Öğrenciler(k, 2)
            S2.Range("E" & 10 + k) = Öğrenciler(k, 3)
        Next k
        S2.Range("C16") = Say
        i = i + Say - 1
        If i Mod 2 And i < UBound(Veri, 1) Then
            S2.Rows("1:32").Copy S2.Rows("35:66")
        Else
            S2.PrintOut
            FormAlanları.Offset(0, 0) = ""
            FormAlanları.Offset(34, 0) = ""
        End If
    Next i
    Set Bul = Nothing: Set Kurumlar = Nothing: Set S1 = Nothing: Set S2 = Nothing
End Sub

 

[Ercan ÖZYURT]

Ömer bey merhaba yardımlarınız için çok teşekkür ederim. Farkındayım çok fazla oldum, nerden de sardım bu işi başıma da diyebilirsiniz gerçekten haklısınız. Çalıştır dediğimde sadece üst kısımdaki formu dolduruyor, alt kısımdaki form boş kalıyor. ilk işletmeyi üst forma doldurmasını ikinci işletmeyi alt kısımdaki forma doldurmasını istemiştim. Bu sayede kağıttan tasarruf sağlamış oluruz. Birde "Görev Sayfası"n yazdır butonu koyulabilir mi acaba.

 

[ÖmerFaruk]

Birinci kısım benim hatam ve düzelttim.
İkinci isteğiniz olan yazıdr butonu ise zaten Kodların içinde yazıdrıyoruz. Ve bunun için yapmanız gerekeni #8 nolu mesajda 1.başlıta açıkça ifade etmiştim. Sizin yapmanız gereken DELETE tuşuna basma işini de ben yaptım.

Kodlarınızdaki For-Next döngüsü olan kısma aşağıdakiyle değiştirin.

    For i = 1 To UBound(Veri, 1)
        S2.Range("B7") = Veri(i, 5)
        S2.Range("A29") = Veri(i, 4)
        S2.Range("D28") = S1.Range("B2") & " - " & S1.Range("C2")
        S2.Range("D30") = S1.Range("B3")
        S2.Range("D31") = S1.Range("A3")
        Say = WorksheetFunction.CountIf(Kurumlar, Veri(i, 5))
        xSay = WorksheetFunction.Min(5, Say)
        S2.Range("A11:E15").ClearContents
        Öğrenciler = Bul.Offset(i, 0).Resize(Say, 3).Value
        For k = 1 To xSay
            S2.Range("A" & 10 + k) = Öğrenciler(k, 1)
            S2.Range("D" & 10 + k) = Öğrenciler(k, 2)
            S2.Range("E" & 10 + k) = Öğrenciler(k, 3)
        Next k
        S2.Range("C16") = Say
        i = i + Say - 1
        Sayfa = Sayfa + 1
        If Sayfa Mod 2 = 1 And i < UBound(Veri, 1) Then
            S2.Rows("1:32").Copy S2.Rows("35:66")
            FormAlanları.Offset(0, 0) = ""
        Else
            S2.PrintOut
            FormAlanları.Offset(0, 0) = ""
            FormAlanları.Offset(34, 0) = ""
        End If
    Next i

 

[Ercan ÖZYURT]

Çok teşekkür ederim eline sağlık.