• DİKKAT

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

Belirleyeceğim alanı yazdırma alanı belirleme

Katılım
13 Ekim 2005
Mesajlar
135
a ve h sütunları arasında büyük bir listem var.

k1 kücresine yazdığım başlangıç L1 sütuna yazdığın bitiş yazdırma alanı olsun.

k1 hücresine 3 yazdığım zaman a3
L1 hücresine 80 yazdığım zaman h80 olmalı

yani a3 ve h80 aralığını yazdırmalı,


burada amaç istediğim zaman listemden istediğim aralığı yazdırabilmeliyim.

şimdiden teşekkür ederim
 
Son düzenleme:
a ve h sütunları arasında büyük bir listem var.
k1 kücresine yazdığım başlangıç L1 sütuna yazdığın bitiş yazdırma alanı olsun.
k1 hücresine 3 yazdığım zaman a3
L1 hücresine 80 yazdığım zaman h80 olmalı
yani a3 ve h80 aralığını yazdırmalı,
burada amaç istediğim zaman listemden istediğim aralığı yazdırabilmeliyim.
Merhaba.
Basit düşünün; Makro kaydet ile ortaya çıkan sonuca kırmızı bölümleri eklerseniz yeterlidir.:
Kod:
 ActiveSheet.PageSetup.PrintArea = "$A$[COLOR="Red"]" & Range("K1").Text & "[/COLOR]:$H$"[COLOR="#ff0000"] & Range("L1").Text[/COLOR]
 
Şöylede düzenleyebilirsiniz.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells <> Cells(1, 12) Then Exit Sub
If Range("K1") <> "" Then
ActiveSheet.PageSetup.PrintArea = "$A$" & Range("K1").Text & ":$H$" & Range("L1").Text
Else
MsgBox " K1 Boş"
End If
End Sub
 
a ve h sütunları arasında büyük bir listem var.

k1 kücresine yazdığım başlangıç L1 sütuna yazdığın bitiş yazdırma alanı olsun.

k1 hücresine 3 yazdığım zaman a3
L1 hücresine 80 yazdığım zaman h80 olmalı

yani a3 ve h80 aralığını yazdırmalı,


burada amaç istediğim zaman listemden istediğim aralığı yazdırabilmeliyim.

şimdiden teşekkür ederim

.

Bu da formülle:

Print area - Yazdırma alanına:

Kod:
=INDIRECT("A"&Sayfa1!$K$1&":H"&Sayfa1!$L$1)

=DOLAYLI("A"&Sayfa1!$K$1&":H"&Sayfa1!$L$1)

gibi bir formül yazın.

.
 
Şöylede düzenleyebilirsiniz.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells <> Cells(1, 12) Then Exit Sub
If Range("K1") <> "" Then
ActiveSheet.PageSetup.PrintArea = "$A$" & Range("K1").Text & ":$H$" & Range("L1").Text
Else
MsgBox " K1 Boş"
End If
End Sub

bu çok işe yaradı her sayfaya koymam gerekti ama olsun, tek sorun değerlerin birini değiştirdiğim zaman değişmiyor illa aynı bile olsa değerler değiştirmem gerekiyor.

.

Bu da formülle:

Print area - Yazdırma alanına:

Kod:
=INDIRECT("A"&Sayfa1!$K$1&":H"&Sayfa1!$L$1)

=DOLAYLI("A"&Sayfa1!$K$1&":H"&Sayfa1!$L$1)

gibi bir formül yazın.

.

hocam buda çok güzeldi elinize sağlık, her zaman formüller zahmetli olsada 1 tercihimdir. Ama bir kez girebiliyorum sonra yazdırma alanı formülü sabitliyor, 1 kez kullanabiliyorum yani.
 
bu çok işe yaradı her sayfaya koymam gerekti ama olsun, tek sorun değerlerin birini değiştirdiğim zaman değişmiyor illa aynı bile olsa değerler değiştirmem gerekiyor.
Tüm sayfalarda işlemesini istediğiniz kodlarınızı: "ThisWorkbook" kod sayfasına ekleyerek şöyle deneyin.
Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [K1:L1]) Is Nothing Then Exit Sub
If [K1] = "" Or [L1] = "" Then ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.PrintArea = "$A$" & Range("K1").Text & ":$H$" & Range("L1").Text
End Sub
 
Son düzenleme:
Tüm sayfalarda işlemesini istediğiniz kodlarınızı: "ThisWorkbook" kod sayfasına ekleyerek şöyle deneyin.
Kod:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [K1:L1]) Is Nothing Then Exit Sub
If [K1] = "" Or [L1] = "" Then ActiveSheet.PageSetup.PrintArea = ""
ActiveSheet.PageSetup.PrintArea = "$A$" & Range("K1").Text & ":$H$" & Range("L1").Text
End Sub

bunda da değer girmem gerekiyor en az birinin değerini,

peki a3 tan başlayan ve h? ye kadar olan dolu sayfaları otomatik yazdırma alanı olarak belirleyebilirmiyim, yani değer girip çıkınca yazdırma alanı değişen
 
Verinin olduğu aralığa kadar yazdırır.
Kod:
Sub Yazdır()
Range([A3], [H3].End(xlDown)).PrintOut
End Sub
 
Geri
Üst