Hücrelerle ilgili çıktı-sayfa ayarı sorunu ?

[FiRARDA]

Merhaba excel dosyamızda 12900 adet tek sıralı hücre var çıktı alırken bunların yan tarafı boş kalıyor ve kağıt tasarrufu yapmamız gerek toplam 250 sayfa civarlarında bu alttaki hücreleri nasıl düzgün sekilde yan hücreye taşıyp bunlar baskıda a4 ebatına sığdırabilirim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz. Kod çalışmanıza "YAZDIR" isimli yeni bir sayfa ekler. Yeni liste bu sayfada oluşturulur ve sizden yazıcı seçmenizi ister, seçim yaptıktan sonrada ilgili sayfayı yazdırır. En son olarakta eklenen sayfa silinir.

Option Explicit
 
Sub YAZDIR()
    Dim S1 As Worksheet, SY As Worksheet
    Dim SAY As Integer, SATIR As Long
    Dim X As Integer, ADRES As String
    
    Application.ScreenUpdating = True
    
    On Error GoTo Devam
    Application.DisplayAlerts = False
    Sheets("YAZDIR").Delete
    Application.DisplayAlerts = True
    
Devam:
    Set S1 = Sheets("ÜRÜN LİSTESİ")
    Set SY = Sheets.Add
    SY.Name = "YAZDIR"
    
    S1.Select
    ActiveWindow.View = 2
    SAY = ActiveSheet.HPageBreaks.Count
    SATIR = ActiveSheet.HPageBreaks.Item(1).Location.Row
    Range(Cells(1, 1), Cells(SATIR, 1)).Copy SY.Range("A1")
    Range("A1").Copy SY.Range("B1")
    
    For X = 1 To SAY
        SATIR = ActiveSheet.HPageBreaks.Item(X).Location.Row
        ADRES = "A" & SATIR & ":A" & ((SATIR * 2) - 2)
        If X Mod 2 = 0 Then
            Range(ADRES).Copy SY.Range("A" & SY.Range("A65536").End(3).Row + 1)
        Else
            Range(ADRES).Copy SY.Range("B" & SY.Range("B65536").End(3).Row + 1)
        End If
    Next
    
    ActiveWindow.View = 1

    SY.Select
    SY.Cells.EntireColumn.AutoFit
    SY.PageSetup.PrintTitleRows = "$1:$1"

    Application.Dialogs(xlDialogPrinterSetup).Show
    SY.PrintOut Copies:=1, Collate:=True
    
    Application.DisplayAlerts = False
    SY.Delete
    Application.DisplayAlerts = True
 
    Set S1 = Nothing
    Set SY = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[FiRARDA]

hemen deneyeceğim teşekkürler

 

[FiRARDA]

pek, bunu nereye ve nasıl uygulayacağım exceli tam olarak bilmiyorum yani hücre içinemi yapıştıracam yoksa başka bir menüdenmi yapılacak bu işlem

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki linkleri inceleyiniz.

http://www.excel.web.tr/showthread.php?t=73353
http://www.excel.web.tr/showthread.php?t=59436