Yazıcıdan belirli satırların yazdırılması

[mozdem]

Merhabalar,
yazdırma alanı AB sütunu olan bir sayfanın J1 ve K1 hücresine göre yada M1 ve N1 hücredeki değer aralığına göre satırların yazdırılmasını istiyorum. Ancak 1. ve 2nci satır başlık olarak mutlaka yazdırılmalı.
Örnek dosyam ekte, yarımlarınızı bekliyorum.
Şimdiden ilgilenen tüm herkese teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Biraz acemice olabilir ancak, sonuç hasıl oluyor.
Tarihlerin eksiksiz yazıldığı (ilgili ayın birinci ve sonuncu gününün A sütununda mutlaka yazıldığı) varsayılmıştır.

Aşağıdaki kod'u, alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan
VBA ekranının sağ tarafındaki boş alana yapıştırın.

J1 veya K1 hücresinde değişiklik olduğunda kod otomatik olarak çalışırak;
-- yazılan ay ve yıla ait veri varsa yazdırır,
-- yazılan ay ve yıla ait veri yoksa, buna ilişkin uyarı görüntülenerek işlemi sonlandırır.
NOT: M1 ve N1 hücresinde işlem yapmayın, zira kod, bu hücreleri de kullanmaktadır.
.

[FONT="Arial Narrow"][B][COLOR="Blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Intersect(Target, [J1:K1]) Is Nothing Then Exit Sub
Call YAZDIR
[B][COLOR="blue"]End Sub[/COLOR][/B]

[COLOR="blue"][B]Sub YAZDIR()[/B][/COLOR]
Application.ScreenUpdating = False
[M1].Formula = "=EOMONTH(0+(""1."" & J1 & ""."" & K1),-1)+1": [M1] = [M1].Value
[N1].Formula = "=EOMONTH(0+(""1."" & J1 & ""."" & K1),0)": [N1] = [N1]
If WorksheetFunction.CountIf(Range("A:A"), [M1]) = 0 Or WorksheetFunction.CountIf(Range("A:A"), [N1]) = 0 Then
    MsgBox "HATA: Seçilen ay'a ait veri yok": GoTo 10
End If
ilk = WorksheetFunction.Match(WorksheetFunction.EoMonth(CDate(1 & "." & [J1] & "." & [k1]), -1) + 1, Range("A:A"), 0)
son = WorksheetFunction.Match(WorksheetFunction.EoMonth(CDate(1 & "." & [J1] & "." & [k1]), 0), Range("A:A"), 0)
ActiveSheet.PageSetup.PrintArea = "$A$" & ilk & ":$B$" & son: Application.PrintCommunication = False
    ActiveSheet.PageSetup.PrintTitleRows = "$1:$2"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
10: Range("M1:N1").ClearContents: Application.ScreenUpdating = True
[B][COLOR="blue"]End Sub[/COLOR][/B][/FONT]

 

[mozdem]

Merhaba.

Biraz acemice olabilir ancak, sonuç hasıl oluyor.
Tarihlerin eksiksiz yazıldığı (ilgili ayın birinci ve sonuncu gününün A sütununda mutlaka yazıldığı) varsayılmıştır.

Aşağıdaki kod'u, alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan
VBA ekranının sağ tarafındaki boş alana yapıştırın.

J1 veya K1 hücresinde değişiklik olduğunda kod otomatik olarak çalışırak;
-- yazılan ay ve yıla ait veri varsa yazdırır,
-- yazılan ay ve yıla ait veri yoksa, buna ilişkin uyarı görüntülenerek işlemi sonlandırır.
NOT: M1 ve N1 hücresinde işlem yapmayın, zira kod, bu hücreleri de kullanmaktadır.
.

[FONT="Arial Narrow"][B][COLOR="Blue"]Private Sub Worksheet_Change(ByVal Target As Range)[/COLOR][/B]
If Intersect(Target, [J1:K1]) Is Nothing Then Exit Sub
Call YAZDIR
[B][COLOR="blue"]End Sub[/COLOR][/B]

[COLOR="blue"][B]Sub YAZDIR()[/B][/COLOR]
Application.ScreenUpdating = False
[M1].Formula = "=EOMONTH(0+(""1."" & J1 & ""."" & K1),-1)+1": [M1] = [M1].Value
[N1].Formula = "=EOMONTH(0+(""1."" & J1 & ""."" & K1),0)": [N1] = [N1]
If WorksheetFunction.CountIf(Range("A:A"), [M1]) = 0 Or WorksheetFunction.CountIf(Range("A:A"), [N1]) = 0 Then
    MsgBox "HATA: Seçilen ay'a ait veri yok": GoTo 10
End If
ilk = WorksheetFunction.Match(WorksheetFunction.EoMonth(CDate(1 & "." & [J1] & "." & [k1]), -1) + 1, Range("A:A"), 0)
son = WorksheetFunction.Match(WorksheetFunction.EoMonth(CDate(1 & "." & [J1] & "." & [k1]), 0), Range("A:A"), 0)
ActiveSheet.PageSetup.PrintArea = "$A$" & ilk & ":$B$" & son: Application.PrintCommunication = False
    ActiveSheet.PageSetup.PrintTitleRows = "$1:$2"
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
10: Range("M1:N1").ClearContents: Application.ScreenUpdating = True
[B][COLOR="blue"]End Sub[/COLOR][/B][/FONT]

Teşekkür ederim ellerinize sağlık