Yazdırma Alanını Otomatik Belirleme

[millis]

Sayın üstadlar ve arkadaşlar. Yapmak istediğim olay. Sayfa içerisinde devamlı verilerin artmasından dolayı raporlamak ve yazdırmak istediğimde yazdırma alanının otomatik olarak dolu olan en alt satıra kadar belirlemesi ve bu alanı yazdırması. A - K sütünları arasındaki verilerin en sonuna kadar yazdırma alanını macro olarak belirlemesi ve bu alanların yazılması. Bu konu da yardımcı olacak üstadlara ve arkadaşlara şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Yazdir()
    
    Dim sat As Long
    
    sat = [A:K].Find("*", , , , xlByRows, xlPrevious).Row
 
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & sat
    ActiveSheet.PrintOut
    
End Sub

.

 

[millis]

İlgilendiğiniz için tşk.ederim. Anck sadece yazdırma alanını belirlemesini istiyorum. Söyle bir örnek gönderiyorum. Ekli dosyada görüldüğü gibi olan listeyi A sütunundan K sütununa kadar olan kısmını aşağıda dolu en son satıra kadar Yazdırma alanını belirlemesini istiyorum. L ve M sütunlarını seçmeyecek ve yazdırma ön izleme yaptığımda sadece A sütunundan K sütununa kadar olan yazılı yerleri belirleyip döküman aldığımda bu listeyi verecek. Bu listeye yeni eklemeler oldukça Macro yazdırma alanını en son kayıda kadar genişletecek. Böyle bir konuda yardımlarınızı istiyorum. Saygılarımla.

 

[millis]

dosya ekliyorum.

 

[Ömer]

Kodlarda bulunan aşağıdaki satırı silerseniz sadece yazdırma alanını belirler.

ActiveSheet.PrintOut

 

[millis]

İlginize teşekkür ederim üstad. Yanlız uyguladığımda. 2 boş sayfayıda seçiyor.

 

[Ömer]

J sütununda formül olduğu için ve bu formül 125. satıra kadar ilerlediği için tüm sayfayı aldı. Keşke dosyanızı ilk mesajınızda ekleseydiniz.

Bu şekilde deneyin.

Sub Yazdir()
    
    Dim sat As Long
    
    sat = Cells(Rows.Count, "B").End(xlUp).Row
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & sat
    
End Sub

.

 

[millis]

Çok teşekkür ederim üstad. Şimdi oldu. Haklısınız dosyayıda göndermem gerekiyordu. Uğraştırdım sizi kusura bakmayın. Emeğinize ve bilginize sağlık.

 

[Internetabi]

Hocam Ben Bendeki Dökümana Bunu Uyguladım Bunu Bir Buton Oluşturupmu Makroyu o Butona Atayacağız Bilgi verirseniz sevinirim excelde pek iyi değilimde.

 

[EmrExcel16]

Hocam Ben Bendeki Dökümana Bunu Uyguladım Bunu Bir Buton Oluşturupmu Makroyu o Butona Atayacağız Bilgi verirseniz sevinirim excelde pek iyi değilimde.

Ömer hocam daha iyibilir ama
Her iki şekildede yapılabilir isterseniz hazır olan kodunuza ekleyin isterseniz ayrı bir buton oluşturup o butona ekleyin karar sizin

 

[uurc1]

Sub Yazdir()
    
    Dim sat As Long
    
    sat = [A:K].Find("*", , , , xlByRows, xlPrevious).Row
 
    ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & sat
    ActiveSheet.PrintOut
    
End Sub

bu komut ile yazdır butonu sayfa 2 de iken sayfa 1 de yer alan veriyi nasıl yazdırabilirim komut bu haldeyken butonun bulunduğu sayfayı yazdırıyor.
şimdiden teşekkür ederim

 

[Korhan Ayhan]

Deneyiniz.

Sub Yazdir()
    Dim Satir As Long, S1 As Worksheet
    Set S1 = Sheets("Sayfa1")
    On Error Resume Next
    Satir = S1.Range("A:K").Find("*", , , , xlByRows, xlPrevious).Row
    On Error GoTo 0
    If Satir > 0 Then
        S1.PageSetup.PrintArea = "$A$1:$K$" & Satir
        S1.PrintOut
    Else
        MsgBox "Sayfada yazdırılacak veri bulunamadı!", vbExclamation
    End If
End Sub

 

[smmmreceptoksoy]

Übtat aşağıdaki makro çok güzel çalışıyor. Ancak ben sütun sayısınıda bazen sabitleyemiyorum. k sütununu yerine sütun sayarak işlem yapılamazmı.


Sub Yazdir()

Dim sat As Long

sat = [A:K].Find("*", , , , xlByRows, xlPrevious).Row

ActiveSheet.PageSetup.PrintArea = "$A$1:$K$" & sat
ActiveSheet.PrintOut

End Sub

 

[BedriA]

Arkadaşlar,

Aşağıdaki kodda bir değişiklik yapmam gerekiyor ancak beceremedim.
Kırmızı kısımlardaki "K" yerine değişken, yani "sutun" gelmesi gerekiyor.

Yardımcı olabilir misiniz?

Sub fan()

Sheets("ListeH").Select
Range("BE2").Select
ActiveCell.FormulaR1C1 = "=COUNTA(RC[-53]:RC[-1])"

No = Sheets("ListeH").Range("BE2").Value
Sutun = Split(Columns(Val(No + 3)).Address, ":$")(1) 'Harf saptanıyor.

sat = [A:[COLOR="red"]K[/COLOR]].Find("*", , , , xlByRows, xlPrevious).Row
ActiveSheet.PageSetup.PrintArea = "$A$1:$[COLOR="Red"]K[/COLOR]$" & sat

End Sub

 

[BedriA]

Aradığımı şu linkte buldum.