Hazırlanan şablonu istenilen aralığa uyacak şekilde yazdırma

[ahmet215]

Hazırlanan şablonu istenilen aralığa uyacak şekilde yazdırma

Merhaba arkadaşlar ben bir şirkette personel sorumlusu olarak çalışıyorum. Excel'de maaş ile ilgili hazırladığım liste ve tablo isimli sayfalar var, liste sayfasındaki yatay olan verileri tablo sayfasında dikey olarak (liste başlıkları ile beraber) yazdırmak istiyorum ve bu tablo sayfasında oluşan dikey verileri (ücret pusulası gibi düşünün) A4 kağıdına 6 adet sığayacak şekilde yazdırmak istiyorum ve bunu 220 personel için yapmam lazım. Bu konuda bana acil olarak yardımcı olur musunuz?

Şimdiden teşekkür ederim.

 

[fedeal]

ben bu soruya kendimce şöyle bir yanıt buldum. herseferinde 1 sayfanın cıktısını alabiliyorsunuz x işareti koydugunuz hücrenin karşısındaki 6 satırın. hepsinin aynı anda çıktısını aldırmak beni aşıyor neyse buyrun:

 

[ahmet215]

Teşekkür ederim arkadaşım ama tam olarak işimi görmedi, çünkü personel sayısı 200 kişi. Bunların hepsini formülü doldur yöntemi ile çok kısa bir süre de yapmak istiyorum aynı zamanda liste başlıklarını da (sicil kodu, adı soyadı, gün vb. gibi) otomatik yaptırmak istiyorum.

Yine de teşekkür ederim, ilgi ve alakanız için.

 

[fedeal]

formül doldur yöntemine uyarladım ama liste başlıklarını otamatik doldurmadan kastınız ne nerden alınacak veriler?
ben tablo sayfasını yaptım bi bakın

 

[ahmet215]

Arkadaşım teşekkür ederim, demek istediğim aşağı yukarı oldu gibi, ancak 1-2 şey daha rica edebilirmiyim. Liste sayfasındaki başlıkları (adı soyadı, gün, maaşı, fazla mesai vb gibi) değiştirdiğim zaman tablo sayfasındaki başlıkları otomatik olarak değiştirmesi benim için daha iyi olacak, son birşey daha Tablo sayfasındaki sıralamayı yan yana değil de, aşağıya doğru dikey bir şekilde olursa daha iyi olacak.

Teşekkürler, kolay gelsin.

 

[fedeal]

başlıklar tamam ama aşagı dogru yapamadım onun içinde hocalarımızdan biri yardım ederse olur)

 

[fedeal]

istediginiz bu galiba

dosyayı incelermisiniz

 

[ahmet215]

Fedeal arkadaşım, eline yüreğine sağlık tam istediğim gibi oldu, çok teşekkür ederim.

İyi çalışmalar, kolay gelsin.

 

[Necdet]

Sanırım Şablon kullanmak daha mantıklı.
Personel sayısından bağımsız olarak kullanabilirsiniz.

 

[fedeal]

ricaederim iyi calışmalar.

 

[Necdet]

Merhaba,

Makrolu çözüm isterseniz eğer :

Şablon sayfasında 6 kişi vardır. Makro bu 6 kişiyi doldurduktan sonra yazıcıdan çıktısını alır.

Dolayısıyla kişi sayısına bağlı kalmaksızın rahatlıkla çalışabilirsiniz.

Tabii ki sütunda değişiklik yapmamak şartıyla

Liste sayfasında A1:O1 arasını dikkate alır, burada yapılacak değişiklikler Şablon sayfasına aktarılır.

Bir deneyiniz.

Kodda ss.PrintPreview gördüğünüz satırları açıklama olarak saklayıp (satırın başına tek tırnak koymak yeterli) ss.PrintOut olan satırın açıklamasını kaldırırsanaz, doğrudan yazıcıya (varsayılan yazıcı) döker.

Bu dosyayı inceleyecek arkadaşlar için ekrana döktürdüm.

Option Base 1
Sub Listele()
Set sl = Sheets("Liste")
Set ss = Sheets("Şablon")
Dim d, i, Satır, Sat, Kol, Sütun As Integer
d = Array(1, 17, 33)
Application.ScreenUpdating = False
ss.[A1:E47].ClearContents
sl.Range("A1:O1").Copy
For i = 1 To 3          '---------- Başlıkları Aktarım Döngüsü
    Sat = d(i)
    ss.Cells(Sat, 1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    ss.Cells(Sat, 4).PasteSpecial Paste:=xlPasteValues, Transpose:=True
Next i                  '---------- Başlıkların Aktarım Döngü Sonu
Sütun = 1
Satır = 1
Sat = 1
For i = 2 To sl.[B65536].End(3).Row     '------- Personel Bilgilerinin Aktarım Döngüsü
    
    If Sütun > 2 Then
        Sütun = 1
        Satır = Satır + 1
        If Satır > 3 Then
            Satır = 1
[B][COLOR=red]'            ss.PrintOut
[/COLOR][COLOR=orange]            ss.PrintPreview
[/COLOR][/B]            ss.[B1:B47, E1:E47].ClearContents
        End If
        Sat = d(Satır)
    End If
    
    If Sütun = 1 Then
        Kol = 2
    Else
        Kol = 5
    End If
    
    sl.Range("A" & i & ":O" & i).Copy
    ss.Cells(Sat, Kol).PasteSpecial Paste:=xlPasteValues, Transpose:=True
    
    Sütun = Sütun + 1
Next i                                  '------- Personel Bilgilerinin Aktarım Döngüsü Sonu

i = i - 1
i = i Mod 6
[B][COLOR=red]'If i <> 0 Then ss.PrintOut
[/COLOR][COLOR=orange]If i <> 0 Then ss.PrintPreview[/COLOR][/B]
MsgBox "Aktarım ve Yazdırma Bitmiştir........."
Application.CutCopyMode = False
End Sub

 

[fedeal]

hocam cok güzel olmuş emegine saglık gerci konuyu ben açmamıştım ama benim için cok faydalı oldugu için tşekkürü borç bildim.

 

[Necdet]

Bende sizin çalışmanızı kullandım Sayın fedeal,

Bende size teşekkür ederim. Bir arkadaşımızın derdine çare olduğunuz için.