Değişken hücre adresi...

[acolkesen1]

Merhaba,
....................
ss = [A65536].End(3).Row
Range("A1:A" & ss).PrintOut .............
.....................
komutu ile a sütununda son dolu satıra kadar olan hücreleri yazdırıyorum. Ancak bu kodu , sabit hücre yerine aktif hücreye göre nasıl düzenleyebilirim? Yani hangi hücre aktifse o sütunun son dolu satırına kadar yazdırma komutunu nasıl verebilirm? Yardımcı olacak arkadaşlara teşekkür ederim.

 

[Zeki Gürsoy]

Merhaba,

Sanırım şunun gibi birşey...

range("a1:" & chr(activecell.column + 64) & ss).printout

 

[acolkesen1]

Merhaba Sayın Zeki Gürsoy,
Yazdırmak istediğim alan A1 den başlamıyor aslında..A1 yerine Activecell ifadesini nasıl yazacağım bunu öğrenmek istiyorum..
Yani; Range(ActiveCell & Chr(ActiveCell.Column + 64) & ss).PrintOut
gibi bir şey olması gerekiyor .. Hangi hücre aktifse, aktif hücreden başlayarak aynı sütunun son dolu satırına kadar yazdırılması gerekiyor..
umarım anlatabilmişimdir..

 

[halit3]

alternatif kod

sut = Selection.Column
sat = Cells(Rows.Count, sut).End(3).Row
Range(Cells(1, 1), Cells(sat, sut)).PrintOut

 

[Zeki Gürsoy]

Bunu deneyin...

r = activecell.row 'numerik değer 1 - 65536
c = chr(activecell.column + 64) 'metin değer A - Z
range(c & r ":" c & ss).printout

 

[acolkesen1]

Sayın Zeki Gürsoy'a ve Sayın Halit3'e ilgilerinden dolayı teşekkür ederim. Ancak Zeki beyin kodları son satırında hata veriyor. Halit3 Beyin kodları çalışıyor ama her seferinde önce a sütunundaki veriyi sonra aktif hücrenin bulunduğu sütunu yazdırıyor. Sadece aktif hücrenin bulunduğu sütunu yazdırması gerekiyor oysa.. Örnek dosya ektedir. İlgilerine tekrar teşekkür ederim..

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub SEÇİLİ_ALANI_YAZDIR()
    Dim Son_Satır As Long, Sütun As Byte
    Son_Satır = Cells(65536, ActiveCell.Column).End(3).Row
    Sütun = ActiveCell.Column
    Range(Cells(1, Sütun), Cells(Son_Satır, Sütun)).PrintOut
End Sub

 

[halit3]

bunları denermisiniz.

Sub yazdır1()
yer = ActiveSheet.Name 'sayfa adı
sut = Selection.Column
sat = Worksheets(yer).Cells(Rows.Count, sut).End(3).Row
Worksheets(yer).Range(Worksheets(yer).Cells(1, 1), Worksheets(yer).Cells(sat, sut)).Select
yaz = Worksheets(yer).Range(Worksheets(yer).Cells(1, 1), Worksheets(yer).Cells(sat, sut)).Address
a = MsgBox(yaz & " Yazdırmak İstiyormusunuz..?", vbYesNo, "Uyarı")
If a = 6 Then
Worksheets(yer).PageSetup.PrintArea = yaz
Worksheets(yer).PrintOut Copies:=1, Collate:=True
SaveAsUI = True
ElseIf a = 7 Then
Cancel = True
End If
End Sub

Sub yazdır2()
yer = ActiveSheet.Name
sut = Selection.Column
sat = Worksheets(yer).Cells(Rows.Count, sut).End(3).Row
Worksheets(yer).Range(Worksheets(yer).Cells(1, sut), Worksheets(yer).Cells(sat, sut)).Select
yaz = Worksheets(yer).Range(Worksheets(yer).Cells(1, sut), Worksheets(yer).Cells(sat, sut)).Address
a = MsgBox(yaz & " Yazdırmak İstiyormusunuz..?", vbYesNo, "Uyarı")
If a = 6 Then
Worksheets(yer).PageSetup.PrintArea = yaz
Worksheets(yer).PrintOut Copies:=1, Collate:=True
SaveAsUI = True
ElseIf a = 7 Then
Cancel = True
End If
End Sub

 

[acolkesen1]

Merhaba,
Biraz geç oldu ama Sayın Korhan Ayhan'a ve sayın Halt3'e ilgilerinden dolayı teşekkür ederim. Bilgi olarak; Sayın korhan Ayhan'ın kodları, yapmak istediklerimi tam olarak karşılıyor..Sayın Halit3' kodlarıyla A1 den itibren Aktif sütunun ilk hücresi arasındaki bölüm yazdırılıyor. Her iki arkadaşımıza da ilgilerinden ve yardımlarından dolayı tekrar teşekkür eder esenlikler dilerim.