Makroyla satır atlatma ve yazdırma

[Desibel]

Merhaba arkadaşlar,

Çalıştığım kurumda şubelerimize hergün zarf ile evrak yollamamız gerekiyor. Şubeler kod halinde. Yapmak istediğim (ve yapamadığım ) şey, şubelerin sıralı kod listesinden ilk satırdan başlayarak sırayla aşağıya doğru inip çıktı alacak bir makro. Ne yaptıysam beceremedim.

Ekteki dosyaya göz atarsanız daha açıklayıcı olur sanırım.

Yardımlarınız için şimdiden çok teşekkürler.

Saygılar,
Sibel

Not: Ofis 2007 dosyasıdır.


Dosya indirmede sorun olursa buradan da indirebilirsiniz : İndir

 

[Ayhan Ercan]

Merhaba,

Ek dosyada "Sorun şu, sol taraftaki oka her seferinde basıp çıktı almak oldukça zamanımızı alıyor. Bunu bizim yerimize yapacak bir makro lazım." diye yazmışsınız.

Ya ben yanlış anladım ya siz yanlış anlatıyorsunuz. Oka basmak için bir makro olurmu? oka basmak için oka basmanız gerekir.....

 

[uzmanamele]

merhaba

aşağıdaki kod işinizi görür mü?

Sub mektup_yaz()
Application.ScreenUpdating = False
ss = Sheets("ZarfYazılacakŞube").Range("b65536").End(3).Row
For i = 2 To ss
Sheets("Zarf").Range("a7") = Sheets("ZarfYazılacakŞube").Range("b" & i)
Sheets("Zarf").PrintOut
Next
Application.ScreenUpdating = True
End Sub

 

[Desibel]

Yanıtlarınız ve ilginiz için çok teşekkür ederim.

Ayhan Bey,

Ok düğmesini E3 hücresindeki değeri artırmak için koydum. Amaç oka basmak değil, E3 hücresindeki değeri otomatik olarak her seferinde artırıp çıktı almak. Bunu başarabilirsek oka gerek kalmayacak.

Uzmanamele Bey

VB bilgim inanın çok kısıtlı, belki de doğru komutu verdiniz ama ne hikmetse ben çalıştırdığımda bir netice alamadım.

İsterseniz sorumu güncelleyim. Anlatma özürlüyüm beceremedim Dosyaya da gerek yok.

"Bir hücredeki değeri otomatik olarak artıran bir makro lazım. Yani makro çalıştığında E3 hücresi 1 den başlayarak 2,3,4,5... diye artarak her basamakta çıktı alacak."

Tekrar çok teşekkürler.

 

[uzmanamele]

merhaba

ek dosya işinizi görür mü?

 

[Necdet]

Merhaba,

Sub Yaz()
Dim sz As Worksheet
Dim szy As Worksheet
Dim i As Long
Set sz = Sheets("Zarf")
Set szy = Sheets("ZarfYazılacakŞube")
sz.Select
For i = 2 To szy.[B65536].End(3).Row
    Range("A7") = szy.Cells(i, "B") & " - " & szy.Cells(i, "C")
    Range("A8") = szy.Cells(i, "D") & " NYM"
'    ActiveSheet.PrintPreview
    ActiveSheet.PrintOut
Next i
End Sub

 

[Desibel]

Cevaplarınız ve ilginiz için çok teşekkür ederim. Denedim süper çalışıyor. Elleriniz dert görmesin ne diyim

Şimdi aynı kodu başka bir çalışmam var ona da deniycem, inşallah yapabilirim. Yapamazsam utanarak tekrar yardımınıza ihtiyaç duyabilirim.

Görüşmek üzere...

 

[Desibel]

Yine ben

Öncelikle yardımlarınız için çok teşekkür ederim. İnanın çok işimi gördü.

Yalnız son bir ricam olacak. Yine ne yaptıysam beceremedim.

Ek'teki dosyada yukarıdaki kod yardımıyla bir liste alma programı oluşturdum. Sorun şu ki, bazı şubelerin listesi yarım sayfayı geçmezken, bazılarının sayfalar tutabiliyor.

Makrodaki koda, sadece dolu sayfaları yazdırmamı sağlayacak bir satır ekleyebilir misiniz? Yoksa ya hepsine tek sayfa yazdırılacak, yada yüzlerce boş sayfa çıkacak.

Düzeltme : forumda aradığım çözümü buldum fakat, üstten yinelecek satır eklediğim zaman yine tüm sayfaları yazdırıyor. Bunu nasıl çözebilirim?

Sub Sırala()
Dim sb As Worksheet
Dim sby As Worksheet
Dim i As Long

Set sb = Sheets("Yazdır")
Set sby = Sheets("Sayfa3")

MsgBox "Bu işlem tüm şubelerin posta listelerinin çıktısını alacaktır."
sb.Select

For i = 2 To sby.[A65536].End(3).Row
    Range("B2") = sby.Cells(i, "A")
'    ActiveSheet.PrintPreview
Next i

End Sub

Birde Mesaj kutusu ekledim ama, TAMAM yada iptal seçeneği yapamadım. Tamam diyince yine çıktı alıyor, TAMAM yada İPTAL komutunu nasıl ekleyebilirim?

 

[Ayhan Ercan]

Merhaba

Aşağıdaki kodu denermisiniz..

Sub Sırala()
Dim sb As Worksheet
Dim sby As Worksheet
Dim i As Long, x As Long, a As Long, cevap
Set sb = Sheets("Yazdır")
Set sby = Sheets("Sayfa3")
cevap = MsgBox("Bu işlem tüm şubelerin posta listelerinin çıktısını alacaktır.", vbYesNo, "DİKKAT")
If cevap = vbYes Then
    sb.Select
    For i = 2 To sby.[A65536].End(3).Row
        Range("B2") = sby.Cells(i, "A")
        For a = 8 To [A65536].End(3).Row
            If [B2] = (Cells(a, "I")) Then GoTo devam
            x = a : Exit For
devam:
        Next a
        ActiveSheet.PageSetup.PrintArea = "$B$6:$L$" & x
        ActiveSheet.PrintPreview
    Next i
Else
End If
End Sub

 

[Desibel]

Ayhan Bey, işte şimdi tam istediğim gibi oldu.

Emeği geçen herkese çok ama çok teşekkür ederim, sağolun varolun.