Yazdırma alanını belirleme VBA

[Ergün GÖKER]

Değerli hocalarım herkese hayırlı akşamlar.
Bir çalışmamda kullanmak üzere bir çalışma sayfam var. Bu çalışma sayfama bir veri deposundan makro ile istediğim bilgiler getirilmekte ve makro ile yazdırmaktayım. Hücre aralıklarım B6 ve J hücresinden aşayıya doğru veri gelmektedir. Bu veriler bazen 1000 adet bazen 100 adet olabiliyor, Bazende 20 satır olabiliyor. Ben yazdır makromun içerisine nasıl bir makro bulnalıyımki veri getirme işleminden sonra yazdıracağım yazdırma alanı B6;J.. de bulunan dolu hücreleri yazdırma alanı belirlesin ve yazdırabilsin
Yazdırma makrosunu aşağıya ekliyorum ilginizede çok teşekkür ederim

Private Sub CommandButton2_Click() 'YAZDIR
son = [B65536].End(3).Row
If son < 62 Then
ActiveSheet.PageSetup.PrintArea = "$B$6:$J$" & son
With ActiveSheet.PageSetup
.Zoom = False
End With
ActiveSheet.PrintOut
Else
ActiveSheet.PageSetup.PrintArea = "$B$6:$J$"
With ActiveSheet.PageSetup
.Zoom = 85
End With
ActiveSheet.PrintOut
End If
MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[vardar07]

Eğer yazdırma alanı 62 den büyükse aşağıdaki satır hatalı eksik yer kırmızı ile belirtilmiştir.

Else
ActiveSheet.PageSetup.PrintArea = "$B$6:$J$" [COLOR="Red"]& son[/COLOR]

Bilgi: Kodlarınızı mesaja yazarken mesaj kutusu üzerindeki # işaretine tıklayıp arasına yapıştırın. Daha düzgün ve anlaşılır olur.

 

[Ergün GÖKER]

Vardar07 Hocam Teşekkür ederim lakin sanırım istediğim anlatamadım. Dosyamda özel bilgiler olduğu için paylaşamıyorum. Şöyle anlatayım bir VERİ sayfam var birde RAPOR sayfam ben rapor sayfasında Veri getir makrosu ile VERİ sayfasından verileri getiritiyorum. Yalnız bilgiler gelmeden önce B13 ten başlayıp J sutunu ile alta doğru dolu hücrelerin satırlarını tamamen siliyor ve yeni veriyi getiriyor. Haliyle belirlediğim yazdırma alanını siliyor. Benim istediğim veri geldikten sonra yeniden yazdırma alanını oluşturmasıdır. Haliyle bu B6 dan başlayıp J den alta doğru dolu olan hücreleri kapsayacak. Örnek dosyayı gönderebilirim özelden size bakma şansınız varsa Hocam

 

[vardar07]

Kullandığınız kod yanlış anlamadıysam dediğiniz işi yapıyor. Sadece kırmızılı yerdeki değişikliği yapıp denermisiniz.

Private Sub CommandButton2_Click() 'YAZDIR
'Sheets("OKULSER").Unprotect "52536"
Son = [B65536].End(3).Row
If Son < 62 Then
  ActiveSheet.PageSetup.PrintArea = "$B$6:$J$" & Son + 1
    With ActiveSheet.PageSetup
        .Zoom = False
    End With
  ActiveSheet.PrintOut
Else
  ActiveSheet.PageSetup.PrintArea = [COLOR="Red"]"$B$6:$J$" & Son + 1[/COLOR]
    With ActiveSheet.PageSetup
        .Zoom = 85
    End With
  ActiveSheet.PrintOut
End If
'Sheets("OKULSER").Protect "52536"
MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[Ergün GÖKER]

Evet Hocam Oldu Teşekkür ederim. Saygılarımla