- Katılım
- 18 Ocak 2008
- Mesajlar
- 12,878
- Excel Vers. ve Dili
- 2003 excell türkçe
ve
2007 excell türkçe
benim yazıcım yok ama ofis prağramının sanal yazcısında bu kod çalışıyor.
Kod:
Sub YAZDIR()
Sheets("ANA SAYFA").Select
ActiveSheet.PageSetup.PaperSize = xlPaperA5
'ActiveSheet.PageSetup.PaperSize = xlPaperA4
'ActiveSheet.PageSetup.PaperSize = xlPaperLetter 'Kağıt boyutunu ayarla
For X = 1 To [B3] Step 2
Range("B1") = X
If X = [B3] And [B3] Mod 2 <> 0 Then
Sheets("YAZDIR").PageSetup.PrintArea = "$A$1:$G$24"
Else
Sheets("YAZDIR").PageSetup.PrintArea = "$A$1:$G$48"
End If
Sheets("YAZDIR").PrintOut Copies:=1, Collate:=True
Next
MsgBox "İŞLEMİNİZ TAMAMLANMIŞTIR.", vbInformation
End Sub
