Sıralı Yazdırma Makrosu

[programer]

Ekteki dosyadaki verileri access databes inden alıyorum. Benim yapmak istediğim yazdır butonuna tıkladığım zaman A8 den B55 kadar secip 3 sayfa yazdırması ama A veye B56 hücresinde veri varsa A8:B55 aralığınında 3 sayfa sonrada A56:B103 Aralığından 3 sayfa yazdırması ve eğer A veya B104 hücresinde veri varsa A8:B55 Aralığından 3 sayfa A56:B103 aralığından 3 sayfa ve A104:B152 aralığından 3 sayfa yazdırmasını istiyorum.

Biraz karışık oldu galiba kusura bakmayın. Ancak bu kadar anlaabildim.

 

[cyberwolf1980]

passwordhunter, yemın ederım tanımlamalarından bı sey anlamadım yazdırma aralıklarını ve sayfa sayılarını bıraz daha anlamlı bı sekılde yazarsan sana uygun macroyu bırazdan buraya yazıcam.

ornek

1 ıslem : a.. ıle b.. arasında 3 sayfa yazdırılacak

2 ıslem : a.. ıle b.. arasında 2 sayfa yazdırılacak

3 ıslem : a.. ıle b.. arasında x sayfa yazdırılacak vs .

ok ?

 

[programer]

Arkadaşlar ben A5 kağıdı kullanıyorum. Sayfa1 deki veri uzun olduğu için yazdır dediğimde yazdıracağım dosya 3 sayfaysa önce birinci sayfayı yazdırıyo sonra 2 ve üç ben böyle olmasını istemiyorum. Eğer veri 2 sayfaysa 1 sayfadan önce 3 tane sonra 2'ci sayfadan 3 tane. Eğer 3 sayfa veya daha fazla ise aynen devam edicek.

 

[programer]

veya şöylede olabilir
sayfa1 deki A8:B55 aralıgından 3 sayfa yazdırsın
A56:B103 aralığında veri varsa bundanda 3 adet yazdırsın
A104:B152 aralığında veri varsa bundanda 3 adet yazdırsın

 

[cyberwolf1980]

bı dene bakalım ıstedıgın gıbı oldumu ?

not : sadece yazdırma alanı olarak a8:b55 ve 3 sayfa olarak ayarladım ok ?

hadı kolay gelsın

Sub YAZDIR_1()
Application.Goto Reference:="R8C1:R55C2"
ActiveSheet.PageSetup.PrintArea = "$A$8:$B$55"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA5
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
ActiveWindow.SelectedSheets.PrintPreview
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=3, Collate:=True
End Sub

 

[programer]

Sayın cyberwolf1980 yardımlarınız için teşekkür ederim. Çalışıyor siz çevabı yazdınız bende bitane buldum aşağıdaki şekilde

Private Sub CommandButton1_Click()
ActiveSheet.PageSetup.PrintArea = "$A$8:$D$58"
ActiveWindow.SelectedSheets.PrintOut Copies:=3
If [c59] = "" Then
MsgBox "Sayfada Veri Olmadığından Yazdırılamadı"
Else
ActiveSheet.PageSetup.PrintArea = "$A$59:$D$109"
ActiveWindow.SelectedSheets.PrintOut Copies:=3
End If
If [c110] = "" Then
MsgBox "Sayfada Veri Olmadığından Yazdırılamadı"
Else
ActiveSheet.PageSetup.PrintArea = "$A$110:$D$160"
ActiveWindow.SelectedSheets.PrintOut Copies:=3
End If
End Sub