Excelde Yazdırma butonuna kod atama

serdar.gul · 3 Şubat 2016

Elimdeki excel dosyasında 5.sırada başlıklar yer almaktadır.E6 ile M40000 arasındaki hücreler verilerim olacaktır. Benim istediğim bir tane yazdırma butonu oluşturmak ve bu yazdırma butonuna öle bir makro yazılsın ki ben yazdırma alanını belirlemeden E sütunundaki dosya numarası aynı olanların çıktısını otomatik alsın istiyorum.
Örneğin: 10101,10 nolu rakamdan 5 tane ise 5 i 10102,10 rakamdan 3 tane ise 3 ü yazdır tuşuna bastığımda belirtilen aralığı ve aynı rakamdan olanları otomatik seçip yazdıracak.

Ekte belirtilen rakamları da yazdım yardımcı olabilecek arkadaşlara Şimdiden teşekkür ederim.

serdar.gul · 4 Şubat 2016

Konuyla ilgili yardımcı olabilecek arkadaş yok mu ? En azından ilk 2 dosyanın nasıl yapıldığını söyleye bilecek arkadaş yok mu ve çoğaltmayı nasıl yapacağımı ..

serdar.gul · 4 Şubat 2016

Arkadaşlar ekteki dosyayı biraz daha sadeleştirdim ve renklendirdim anlaşılması için çıktı almadaki zaman kaybını önlemek için yazır butonuna yazılması gereken kod konusunda yardımcı olacak birileri var mı ?? (ACİL)

Orion1 · 4 Şubat 2016

Dosyanız ektedir.

Kod:

Sub ilk_uc()
Dim sh As Worksheet, sonsat As Long, sat As Long
Dim i As Long, sayi As Integer
Set sh = Sheets("Sayfa2")
sh.Range("B2").AutoFilter
Sheets("Sayfa1").Select
sh.Range("B3:K" & Rows.Count).ClearContents
sonsat = Cells(Rows.Count, "E").End(xlUp).Row
sat = 3
Application.ScreenUpdating = False
For i = 6 To sonsat
    sayi = Left(Int(Cells(i, "E").Value), 3)
    sh.Range("B" & sat).Value = sayi
    Range("E" & i & ":M" & i).Copy sh.Range("C" & sat)
    sat = sat + 1
Next i
sh.Range("B3:K" & Rows.Count).Sort sh.Range("B3")
Application.ScreenUpdating = True
sonsat = sh.Cells(Rows.Count, "C").End(xlUp).Row
sh.Range("B3:K" & sonsat).Sort sh.Range("B3")
sh.PageSetup.PrintArea = "Sayfa2!$C$2:$K" & sonsat
For i = 3 To sonsat
    If WorksheetFunction.CountIf(sh.Range("B3:B" & i), sh.Cells(i, "B").Value) = 1 Then
        sh.Range("B2").AutoFilter field:=1, Criteria1:=sh.Cells(i, "B").Value
        sh.PrintOut
        sh.Range("B2").AutoFilter
    End If
Next i
sh.PageSetup.PrintArea = ""
MsgBox "Veriler Yazdırıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

serdar.gul · 5 Şubat 2016

Hocam;

Çıktı alıyor ama Hepsini Tek A4 te benim istediğim buradaki farklı rakamlardaki dosya numaralarını farklı personele vereceğimden örneğin 10101,10 nolu dosya bir A4 te işte A personeline 10102,10 bir A4 te B personeline gibi devam edecek şeklinde olmasını istemiştim çıktıların yani her farklı dosya numarasının bir öncekinden bağımsız başka A4 te çıkması. Bu şekilde olma imkanı varsa daha güzel olur amaç tek tek uğraşmamak

şimdiden teşekkür ederim.

Dosya içerisinde elimde bulunan dosya aralıklarını yazmıştım o aralıktaki aynı olanlar bir A4 te çıkacak (dosyanın içini ben tekrar düzenledim yapmak istediğimi tam olarak anlatamadım sanırım)

hocam tekrar bakar mısınız??

Orion1 · 5 Şubat 2016

serdar.gul' Alıntı:
Hocam;

Çıktı alıyor ama Hepsini Tek A4 te benim istediğim buradaki farklı rakamlardaki dosya numaralarını farklı personele vereceğimden örneğin 10101,10 nolu dosya bir A4 te işte A personeline 10102,10 bir A4 te B personeline gibi devam edecek şeklinde olmasını istemiştim çıktıların yani her farklı dosya numarasının bir öncekinden bağımsız başka A4 te çıkması. Bu şekilde olma imkanı varsa daha güzel olur amaç tek tek uğraşmamak şimdiden teşekkür ederim.

Dosya içerisinde elimde bulunan dosya aralıklarını yazmıştım o aralıktaki aynı olanlar bir A4 te çıkacak (dosyanın içini ben tekrar düzenledim yapmak istediğimi tam olarak anlatamadım sanırım) hocam tekrar bakar mısınız??

Dosyayı güncelledim.
4 nolu mesajdan indirebilirsiniz.

serdar.gul · 6 Şubat 2016

Hocam,

Sanırım ben yazmak istediğimi tam ifade edemedim

şuana kadar tamam ama son bir aşama kalmış oda 10101,10 - 10102,10 - ..... - 10199,10 yani 101 ile başlayanlar kendi içinde 1 ile 99 arası , 102 ile başlayanlar 1 ile 99 arası gibi devam ediyor şeklinde kendi içinde numaralar artıyor benim tam olarak istediğim 101 in kendi içinde kırmızı renk ile artan kısmının bir birinden bağımsız farklı A4 te çıkmasıydı

Bunuda kod olarak ekleye bilirseniz tam olacak diye düşünüyorum kurtarın beni bu çıktı işinden

Orion1 · 6 Şubat 2016

serdar.gul' Alıntı:
Hocam,

Sanırım ben yazmak istediğimi tam ifade edemedim şuana kadar tamam ama son bir aşama kalmış oda 10101,10 - 10102,10 - ..... - 10199,10 yani 101 ile başlayanlar kendi içinde 1 ile 99 arası , 102 ile başlayanlar 1 ile 99 arası gibi devam ediyor şeklinde kendi içinde numaralar artıyor benim tam olarak istediğim 101 in kendi içinde kırmızı renk ile artan kısmının bir birinden bağımsız farklı A4 te çıkmasıydı Bunuda kod olarak ekleye bilirseniz tam olacak diye düşünüyorum kurtarın beni bu çıktı işinden

Ekli dosyayı deneyiniz.

Kod:

Sub ilk_uc()
Dim sh As Worksheet, sonsat As Long, sat As Long
Dim i As Long, sayi As Integer
Set sh = Sheets("Sayfa2")
Sheets("Sayfa1").Select
sh.Range("B3:K" & Rows.Count).ClearContents
sonsat = Cells(Rows.Count, "E").End(xlUp).Row
sat = 3
Application.ScreenUpdating = False
For i = 6 To sonsat
    sayi = Int(Cells(i, "E").Value)
    sh.Range("B" & sat).Value = sayi
    Range("E" & i & ":M" & i).Copy sh.Range("C" & sat)
    sat = sat + 1
Next i
sh.Range("B3:K" & Rows.Count).Sort sh.Range("B3")
Application.ScreenUpdating = True
sonsat = sh.Cells(Rows.Count, "C").End(xlUp).Row
sh.Range("B3:K" & sonsat).Sort sh.Range("B3")
sh.PageSetup.PrintArea = "Sayfa2!$C$2:$K" & sonsat
For i = 3 To sonsat
    If WorksheetFunction.CountIf(sh.Range("B3:B" & i), sh.Cells(i, "B").Value) = 1 Then
        sh.PageSetup.PrintArea = "Sayfa2!$C$" & i & ":$K$" & i
        sh.PrintOut
    End If
Next i
sh.PageSetup.PrintArea = ""
MsgBox "Veriler Yazdırıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

serdar.gul · 8 Şubat 2016

Hocam,

Dosyayı inceledim çıktı kısmı tamam ama şöyle bir eksiği var

1) başlık kısmı yani dosya ,adı soyayı ... gibi olan kısım her A4 ün başında yinelensin

2) örneğin 10101,10 dosyadan size gönderdiğim excel de 4 adet var çıktı olarak aldığımda 1 adet çıkartıyor (10101,10 olanın hepsi bir A4 olacak)

3) küçük bir isteğim olacak bitin çıktılar alındıktan sonra en son A4 bir öncekilerinden bağımsız olarak 10101,10 - 10102,10 dosyalarının olduğu ve aynı dosyadan kaç adet iş verilmiş personele onu gösteren bir çıktı olursa elimde adetler olmuş olur.
örn: 10101,10 = 4
101,02,10 = 2 gibi..

eksikleri tamamladık mı tamamdır hocam

Orion1 · 8 Şubat 2016

2) örneğin 10101,10 dosyadan size gönderdiğim excel de 4 adet var çıktı olarak aldığımda 1 adet çıkartıyor (10101,10 olanın hepsi bir A4 olacak)

4 nolu mesajda bunu yapmıştım daha önce.

Siz bir tanesini istemiştiniz.

serdar.gul · 9 Şubat 2016

Hocam

4 numaralı mesajınızdaki kod ekte yollamış olduğum gibi çıkartıyor (resim 0279)
101 ile başlayanlardan (ekte) kendi içinde
10101,10
10102,10
.
.
10199,10 a kadar gidiyor.Benim tam olarak demek istediğim kırmızı renkle yazılmış olan kısımların (ekte renklendirdiğim kısımlar) aynısından kaç adet varsa en üstte başlık yinelenmesiyle birlikte tek bir A4 te çıkmasıdır. (resim 0280 ekte)

demek istediğim tam olarak bu şekildeydi hocam

serdar.gul · 9 Şubat 2016

Orion Hocam

#11 nolu mesajımda nasıl olması gerektiğini pdf olarak yolladım cevabınızı bekliyorum yazdırma işinden kurtarın beri her gün o kadar dosya uğraşılmıyor

serdar.gul · 10 Şubat 2016

Hocam

Yardımlarınızı Bekliyorum acil

11 nolu mesajdaki ekteki resim 0280 gibi olacak istediğim çıktı.

Orion1 · 10 Şubat 2016

Ekli dosyadaki gibimi?

Kod:

Sub ilk_uc()
Dim sh As Worksheet, sonsat As Long, sat As Long
Dim i As Long, sayi As Long, s2 As Worksheet
Set sh = Sheets("Sayfa2")
Set s2 = Sheets("Sayfa3")
sh.Range("B2").AutoFilter
Sheets("Sayfa1").Select
sh.Range("B3:K" & Rows.Count).ClearContents
s2.Range("B3:C" & Rows.Count).ClearContents
sonsat = Cells(Rows.Count, "E").End(xlUp).Row
sat = 3
Application.ScreenUpdating = False
For i = 6 To sonsat
    sayi = Int(Cells(i, "E").Value)
    sh.Range("B" & sat).Value = sayi
    Range("E" & i & ":M" & i).Copy sh.Range("C" & sat)
    sat = sat + 1
Next i
sonsat = sh.Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = True
sonsat2 = sh.Cells(Rows.Count, "B").End(xlUp).Row
sh.Range("B3:K" & sonsat).Sort sh.Range("B3")
sh.PageSetup.PrintArea = "Sayfa2!$C$2:$K" & sonsat
sat = 3
For i = 3 To sonsat
    If WorksheetFunction.CountIf(sh.Range("B3:B" & i), sh.Cells(i, "B").Value) = 1 Then
        s2.Cells(sat, "B").Value = sh.Cells(i, "B").Value
        s2.Cells(sat, "C").Value = WorksheetFunction.CountIf(sh.Range("B2:B" & _
                sonsat2), sh.Cells(i, "B").Value)
        sat = sat + 1
        sh.Range("B2").AutoFilter field:=1, Criteria1:=sh.Cells(i, "B").Value
        sh.PrintOut
        sh.Range("B2").AutoFilter
    End If
Next i
s2.PrintOut
sh.PageSetup.PrintArea = ""
Set sh = Nothing: Set s2 = Nothing
MsgBox "Veriler Yazdırıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

serdar.gul · 11 Şubat 2016

Hocam

Teşekkür ederim tam olarak istediğim buydu

ama örneğin sizin bana gönderdiğiniz ekte filtreleme yaparsak bir tane dosya numarasını çıkartırsak yazdır dediğimizde oda çıkıyor çıkmama ihtimali varsa daha güzel olur , olmaz ise başka tarafta filtreleyip oraya yapıştırcam artık

* Birde en son çıktıda rapor gibi düşünelim hangi dosyadan kaç adet olabileceğini gösteren bir çıktı mümkünse güzel olur. (rapor olacağından bütün rakamların bir A4 te çıkabilir)
örn: 10101,10= 10 adet
10102,10= 2 adet gibi ..

Orion1 · 12 Şubat 2016

serdar.gul' Alıntı:
Hocam

Teşekkür ederim tam olarak istediğim buydu ama örneğin sizin bana gönderdiğiniz ekte filtreleme yaparsak bir tane dosya numarasını çıkartırsak yazdır dediğimizde oda çıkıyor çıkmama ihtimali varsa daha güzel olur , olmaz ise başka tarafta filtreleyip oraya yapıştırcam artık

* Birde en son çıktıda rapor gibi düşünelim hangi dosyadan kaç adet olabileceğini gösteren bir çıktı mümkünse güzel olur. (rapor olacağından bütün rakamların bir A4 te çıkabilir)
örn: 10101,10= 10 adet
10102,10= 2 adet gibi ..

ilk konuyu anlamadım.
2nci konu için dosyayı güncelledim.14 nolu mesajdan indirebilirsiniz.

serdar.gul · 13 Şubat 2016

Hocam

Teşekkür ederim ilk kısmına gerek kalmadı bu kadar yeterli

Orion1 · 13 Şubat 2016

serdar.gul' Alıntı:
Hocam

Teşekkür ederim ilk kısmına gerek kalmadı bu kadar yeterli

Rica ederim.
İyi çalışmalar.

Excelde Yazdırma butonuna kod atama

serdar.gul

Ekli dosyalar

serdar.gul

serdar.gul

Ekli dosyalar

Orion1

Uzman

Ekli dosyalar

serdar.gul

Ekli dosyalar

Orion1

Uzman

serdar.gul

Orion1

Uzman

Ekli dosyalar

serdar.gul

Orion1

Uzman

serdar.gul

Ekli dosyalar

serdar.gul

serdar.gul

Orion1

Uzman

Ekli dosyalar

serdar.gul

Orion1

Uzman

serdar.gul

Orion1

Uzman