A4 formatında print almak için makro

[elifyağmur]

Merhaba arkadaşlar;
Elimde forumdan bi arkadaşımızın yazdığı referans numarasına göre sırlama yapan bir makro bulunmakta
Sub daylight()
Application.ScreenUpdating = False
Sheets(3).Range("a1:z10000").ClearContents
Sheets(1).Range("ab2:ab10000").ClearContents
Set bul = Sheets(1).Cells.Find("*Referans*", , , 1)
If Not bul Is Nothing Then
adr = bul.Address
Do
Set bul = Sheets(1).Cells.FindNext(bul)
a = Mid(bul.Value, 11, 20)
Sheets(1).Cells([ab10000].End(3).Row + 1, "ab") = a
Loop While Not bul Is Nothing And adr <> bul.Address
End If
Sheets(1).Range("ab2:ab10000").Sort key1:=Range("ab2")
For x = 1 To Sheets(1).[ab1000].End(3).Row - 1
Set bul = Sheets(1).Range("a2:z10000").Find("*" & Sheets(1).Cells(x + 1, "ab") & "*", , , 1)
bb = bul.Row
Sheets(1).Range("a" & bul.Row - 19 & ":z" & bul.Row).Copy
Sheets(3).Range("a" & Sheets(3).[a10000].End(3).Row + 3).PasteSpecial (xlPasteAll)
Next x
Sheets(1).Range("ab2:ab10000").ClearContents
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "İşleminiz bitmiştir.", vbInformation
End Sub
.Fakat sıkıntı bu makroyu çalıştırdığımda her bir tahsilat makbuzumu bir a4 formatına getirebilmek için tekrar tekrar uğraşmak zorunda kalmam.Bu da saatlerimi alıyor.Her bir tahsilat makbuzumu bir a4 formatında alabilmek için hangi makroya ihtiyacım var.İlginize şimdiden teşekkürler.Kolay gelsin

 

[suleyman242]

sıkıntı bu makroyu çalıştırdığımda her bir tahsilat makbuzumu bir a4 formatına getirebilmek için tekrar tekrar uğraşmak zorunda kalmam.Bu da saatlerimi alıyor.Her bir tahsilat makbuzumu bir a4 formatında alabilmek için hangi makroya ihtiyacım var.İlginize şimdiden teşekkürler.Kolay gelsin

makroya ihtiyaç olmadığını düşünüyorum report sayfanı Görünüm>sayfa önizleme kısmından bir defaya mahus ayaryıp yazıcı ayarlarınıda buna göre yaparsanız sıkıntı olmıyacaktır.

 

[Muzaffer Ali]

VBA kodu ile yapmak isterseniz

Sheets(1).PageSetup.PaperSize = xlPaperA4

 

[elifyağmur]

Maalesef bu kod işime yaramadıBenim sayfa1 deki formatımla aynı olması gerekiyor.Çok acil yardımlarınızı bekliyorum.sayfa önizlemeden düzeltme yapmak bu dökümü hep farklı zamanlarda bi internet sayfasından almamız gerekiyo zaten kodu tekrar tekrar yazıcaz.En azından benim aldığım formatta gelirse çok sevinicem.Acil yardımlarınızı bekliyorum.Teşekkürler

 

[Muzaffer Ali]

thisWorkbook kod editörünü açın aşağıdaki size uygun olan kodu yazın.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    ActiveSheet.PageSetup.PaperSize = xlPaperA4
    'Her zaman A4 e göre ayarlar
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim msg As VbMsgBoxResult
    If Not ActiveSheet.PageSetup.PaperSize = xlPaperA4 Then
        msg = MsgBox("Sayfa boyutu A4 olarak ayarlı değil. Şimdi ayarlanmasını ister misiniz?", vbYesNo)
        If msg = vbYes Then
            ActiveSheet.PageSetup.PaperSize = xlPaperA4
        Else
            Cancel = True
        End If
        
    End If
    'Size sorar kabul ederseniz A4 yapar aksi taktirde yazmaz.
End Sub

 

[elifyağmur]

emeğinize teşekkürler ama benim yukarıdaki makroyla entegre çalışan bi makroya ihtiyacım var.ilginize teşekkürler..