Yazdırılacak Kağıt Türünü Seçtirmek

[hamza02]

Private Sub CommandButton2_Click() 'A-5 Yazdır

Sayfa2.Range("A1:H30").Value = Sayfa1.Range("A1:H30").Value
Sayfa2.Rows("9:30").EntireRow.AutoFit
Sayfa2.Range("G32").Value = "Teslim Alan Personel" & vbCrLf & "" & vbCrLf & "Adı Soyadı :" & vbCrLf & "Sicili :" & vbCrLf & "İmza :"

For Each t In Sayfa2.Range("A9:A30").Cells
If t.Value = "" Then
t.EntireRow.Hidden = True
Else
t.EntireRow.Hidden = False
End If
Next t
Sayfa2.Range("A1:H32").PrintOut Copies:=2
Sayfa1.Range("A1:H30").ClearContents
Sayfa1.Range("A1").Select
End Sub




Arkadaşlar merhaba,
Yukarıdaki kodlarla Sayfa1 (Kayıt) 'de, Sayfa2 (A-5) yazdırma yapıyorum.
Aynı kodları yine Sayfa1 (Kayıt) 'den, Sayfa3 (A-4) yazdırma yapıyorum.

Yazdıracağım sayfayı ben seçiyorum. Acaba bunu makro kodları ile sığıyorsa A-5'e yazdırmayı, eğer sığmıyorsa A-4'e yazdırmak mümkün mü acaba.

 

[Korhan Ayhan]

Denemedim ama bu hali işinize yarayabilir..

Private Sub CommandButton2_Click() 'A5 / A4 Otomatik Tek Sayfa

    Dim t As Range
    Dim A5SigiyorMu As Boolean

    'Veri aktar
    Sayfa2.Range("A1:H30").Value = Sayfa1.Range("A1:H30").Value
    Sayfa2.Rows("9:30").EntireRow.AutoFit

    Sayfa2.Range("G32").Value = "Teslim Alan Personel" & vbCrLf & vbCrLf & _
                               "Adı Soyadı :" & vbCrLf & _
                               "Sicili :" & vbCrLf & _
                               "İmza :"

    'Boş satırları gizle
    For Each t In Sayfa2.Range("A9:A30")
        t.EntireRow.Hidden = (t.Value = "")
    Next t

    '--- ÖNCE A5'TE SIĞIYOR MU TEST ---
    With Sayfa2.PageSetup
        .Zoom = 100
        .PaperSize = xlPaperA5
        .Orientation = xlLandscape
    End With

    DoEvents

    A5SigiyorMu = Not (Sayfa2.HPageBreaks.Count > 0 Or Sayfa2.VPageBreaks.Count > 0)

    '--- KARAR ---
    With Sayfa2.PageSetup
        
        If A5SigiyorMu Then
            .PaperSize = xlPaperA5
            .Orientation = xlLandscape   '✅ A5 YATAY
        Else
            .PaperSize = xlPaperA4
            .Orientation = xlPortrait    '✅ A4 DİKEY
        End If

        'Tek sayfa zorla
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1

    End With

    'Yazdır
    Sayfa2.Range("A1:H32").PrintOut Copies:=2

    'Temizlik
    Sayfa1.Range("A1:H30").ClearContents
    Sayfa1.Range("A1").Select

End Sub

 

[hamza02]

Sayın Korhan Ayhan hocam elinize sağlık kodlar çok güzel çalışıyor.

Ancak A-5'e yazdırırken yatay yazdırmam gerekiyor. Bunu ekleyebilir miyiz.

 

[Korhan Ayhan]

Kodu revize ettim. Tekrar deneyiniz.

 

[hamza02]

A-4 ve A-5 her ikisinde yatay olarak A-5'e yazdırıyor

 

[Korhan Ayhan]

Tekrar deneyiniz..

 

[hamza02]

Korhan hocam
çok özür dilerim şimdi de A-4'e yatay yazdırıyor.

Olması gereken,
A-4'e dikey
A-5'e yatay

 

[Korhan Ayhan]

Çözene kadar devam... Tekrar deneyiniz.