Çoklu commandbutton alternatif

[acar6783]

Merhabalar,

Bir sayfa tasarlaycağım ;
Her 5 sütun ve her 45 satır aralığında bir yazdırma butonu koymam gerekiyor.

Bu şekilde olursa toplamda 310 adet buton eklemem gerekiyor ve herbutona da ayrı bir kod.

Alternatif olarak ilgili satır ve sütunlardaki hücrelere (if intersect(target....)ile yapmak istedim onda da cok olasılık var.

Öneriniz hangi yönde olur?

Saygılarımla

 

[Korhan Ayhan]

Seçim yapıp yazdırma işlemi yaptırsanız daha pratik olmaz mı?

 

[muygun]

Merhaba;
Alternatif:
yazdırma aralıklarını bir sayfa yada iki sütunda ve makro içerisinde tanımlarım derseniz eki inceleyin. (ben ayrı bir sayfada tanımladım)

Link:
http://s4.dosya.tc/server5/dhwtdb/acar6783-yazdirma_alani.zip.html

 

[acar6783]

Seçim yapıp yazdırma işlemi yaptırsanız daha pratik olmaz mı?

Korhan bey merhabalar,

Aslında her yazdır butonu olacak yerin üstünde günlük veri girişleri yapılan bölümler var .Buton ile bu hücrelerdeki verileri farklı bir sayfaya aktarıp o sayfayı yazdırıyorum.
Aslında buton hangi sütun grubunun altında ise o verileri tasıyıp yazdırılıacak sayfayı önizeleme olarak açıyor.
Daha önceki yaptığım kod bu şekilde idi;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
stn = Target.Column
  
If Intersect(Target, Cells(32, stn)) Is Nothing Then Exit Sub
 Application.Calculation = xlManual
 Set t = Sheets("KASİYER_TUTANAK")
 
 t.Range("S9:AC19").ClearContents
  t.Range("AD20:AM20").ClearContents
t.Range("AN9:AX20").ClearContents
 t.Range("S9") = Cells(13, stn + 2)
 t.Range("S10") = Cells(14, stn + 2)
 t.Range("S11") = Cells(15, stn + 2)
 t.Range("S12") = Cells(16, stn + 2)
 t.Range("S13") = Cells(17, stn + 2)
 t.Range("S14") = Cells(18, stn + 2)
 t.Range("AD20") = Cells(19, stn + 2)
 t.Range("AN3") = Format(ActiveSheet.Name & "." & Month(Date) & "." & Year(Date), "dd.mm.yyyy")
t.Range("AN4") = Now
t.Range("AN9") = WorksheetFunction.Sum(t.Range("ad9:am20"))
  Application.Calculation = xlAutomatic
 t.PrintOut Copies:=1, Preview:=True


  
 Cells(4, stn + 3).Select
End Sub

 

[acar6783]

Merhaba;
Alternatif:
yazdırma aralıklarını bir sayfa yada iki sütunda ve makro içerisinde tanımlarım derseniz eki inceleyin. (ben ayrı bir sayfada tanımladım)

Link:
http://s4.dosya.tc/server5/dhwtdb/acar6783-yazdirma_alani.zip.html

Sayın Muygun Dosyayı inceledim. Teşekkür ederim fakat benim istediğim yukarıda anlattığım şekilde bir yazdırma olacaktı.
Daha önce eksik anlattım sanırım

 

[acar6783]

Aslında bu şekilde de bir yöntem

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Target) Is Nothing Then Exit Sub
If Cells(Target.Row, Target.Column).Value <> "YAZDIR" Then Exit Sub
[COLOR="Red"]'Kodlar[/COLOR]
End Sub

ile isteğim kısmen oluyor. Buradaki sorun ise Enter tuşuna basıldığında "YAZDIR" olan hücreye gittiğinde yazdırma ekranı açılması.Yani kodların çalışması.

Burada kısaca Çift tıklama olmadan sadece "YAZDIR" yazılı hücreye basıldığında yazdıran alternatif kod ne yazabilirim?

 

[muygun]

Merhaba;
Kodları deneyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
sat = Selection.Cells.Row
süt = Selection.Cells.Column
If Cells(sat, süt).Value = "YAZDIR" Then
MsgBox ("kod çalıştı")
End If
End Sub

İyi çalışmalar.

 

[acar6783]

Teşekkür ederim sayın Muygun yardımınız için,

Sanırım tek tıklamayla olunca her enter tuşuna basınca yazdırolan hücreyi seçince kodlar çalışacaktı o sebepten çifttık olayına kodları yerleştirdim

Teşekkür ederim