- Katılım
- 6 Mart 2011
- Mesajlar
- 153
- Excel Vers. ve Dili
- Microsoft Office 2010
Merhaba
Şantiyemizde çalışmakta olan personellerimize ait birimlerinde yapmış oldukları mesaileri ay sonunda toplu şekilde yazdırmak istiyorum. Örnek dosyamda mesai yapan birimlere ait personeller var Form sayfasında Oluşturmuş olduğum (Beton İşleri, Toprak İşleri, Jeoteknik, Hava Hattı) butonuna bağlı olarak sarı renkte belirttiğim alanlara (Personelin mesaiye kaldığı tarih, adı soyadı, görevi,mesaiye kaldığı yer) alanlarını doldurup yazdırmasını istiyorum. Personellerin karşısına hangi günde mesaiye kalmış ise (1) yazıyorum. Daha öncede farklı bir çalışma ile hazırlanmış kodu bu sisteme uyarlayamadım. Yardımcı olabilir misiniz.
... Örnek Dosya ...
Sub PAZAR_YAZDIR()
Set p = Sheets("PERSONEL"): Set m = Sheets("MESAİ ÇALIŞMA")
sonp = p.Cells(Rows.Count, "B").End(3).Row
If p.Cells(1, Columns.Count).End(xlToLeft).Column = 7 Then Exit Sub
For psut = 8 To p.Cells(1, Columns.Count).End(xlToLeft).Column
If WorksheetFunction.CountIf(p.Range(p.Cells(5, psut), p.Cells(sonp, psut)), 1) > 0 Then
m.[B8] = p.Cells(1, psut)
m.[F23] = p.Cells(1, psut)
m.[F31] = p.Cells(1, psut)
For sat = 5 To sonp Step 2
If p.Cells(sat, psut) = 1 Then
m.[F20] = p.Cells(sat, 2): m.[F21] = p.Cells(sat, 3)
m.[F22] = p.Cells(sat, 4): m.PrintOut
Application.Wait (Now + TimeValue("00:00:02"))
End If
Next
End If
Next
MsgBox "İşlem tamamlandı."
End Sub
Şantiyemizde çalışmakta olan personellerimize ait birimlerinde yapmış oldukları mesaileri ay sonunda toplu şekilde yazdırmak istiyorum. Örnek dosyamda mesai yapan birimlere ait personeller var Form sayfasında Oluşturmuş olduğum (Beton İşleri, Toprak İşleri, Jeoteknik, Hava Hattı) butonuna bağlı olarak sarı renkte belirttiğim alanlara (Personelin mesaiye kaldığı tarih, adı soyadı, görevi,mesaiye kaldığı yer) alanlarını doldurup yazdırmasını istiyorum. Personellerin karşısına hangi günde mesaiye kalmış ise (1) yazıyorum. Daha öncede farklı bir çalışma ile hazırlanmış kodu bu sisteme uyarlayamadım. Yardımcı olabilir misiniz.
... Örnek Dosya ...
Sub PAZAR_YAZDIR()
Set p = Sheets("PERSONEL"): Set m = Sheets("MESAİ ÇALIŞMA")
sonp = p.Cells(Rows.Count, "B").End(3).Row
If p.Cells(1, Columns.Count).End(xlToLeft).Column = 7 Then Exit Sub
For psut = 8 To p.Cells(1, Columns.Count).End(xlToLeft).Column
If WorksheetFunction.CountIf(p.Range(p.Cells(5, psut), p.Cells(sonp, psut)), 1) > 0 Then
m.[B8] = p.Cells(1, psut)
m.[F23] = p.Cells(1, psut)
m.[F31] = p.Cells(1, psut)
For sat = 5 To sonp Step 2
If p.Cells(sat, psut) = 1 Then
m.[F20] = p.Cells(sat, 2): m.[F21] = p.Cells(sat, 3)
m.[F22] = p.Cells(sat, 4): m.PrintOut
Application.Wait (Now + TimeValue("00:00:02"))
End If
Next
End If
Next
MsgBox "İşlem tamamlandı."
End Sub