• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

H

hamza02

Katılım
24 Mart 2021
Mesajlar
50
Excel Vers. ve Dili
Türkçe
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.
 
Denemedim ama bu hali işinize yarayabilir..

C++: 
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
 
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 hocam
çok özür dilerim şimdi de A-4'e yatay yazdırıyor.

Olması gereken,
A-4'e dikey
A-5'e yatay
 
Örnek dosyanızı ekleyin bende deneme yapayım.
 
Şöyle yapalım...

A5 kağıda kaç satır sığıyor. Satır kontrolü ile sayfa seçimi yapalım.
 
Hücreler içindeki verilerin uzunluğuna göre satır yüksekliği değiştiğinden satır sayısı sabit olmuyor.
 
Bunu bir deneyiniz..

C++: 
Private Sub CommandButton2_Click() 'A5 / A4 Otomatik (Yükseklik Bazlı)
    Dim t As Range
    Dim r As Range
    Dim toplamYukseklik As Double

    '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

    '--- TOPLAM YÜKSEKLİK HESAPLA ---
    toplamYukseklik = 0

    For Each r In Sayfa2.Rows("1:32")
        If r.Hidden = False Then
            toplamYukseklik = toplamYukseklik + r.RowHeight
        End If
    Next r

    '--- SAYFA AYARI ---
    With Sayfa2.PageSetup
        'Tek sayfa zorla
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1

        'Karar
        If toplamYukseklik < 500 Then
            .PaperSize = xlPaperA5
            .Orientation = xlLandscape   'A5 YATAY
        Else
            .PaperSize = xlPaperA4
            .Orientation = xlPortrait    'A4 DİKEY
        End If
    End With

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

    'Temizlik
    Sayfa1.Range("A1:H30").ClearContents
    Sayfa1.Range("A1").Select
End Sub
 
Sayın Korhan Ayhan hocam,

Denedim sorunsuz çalıştı. Elinize emeğinize sağlık.
Çok emek verdiniz, zaman ayırdınız. Her şey için çok teşekkür ederim.
Allah razı olsun.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst