Çalışma sayfalarının toplu çıktılarını almak

[ockucukay]

Merhaba

Listede gördüğünüz sayfaları makroyla oluşturduktan sonra raporlarını hazırlayıp çıktılarını alıyorum. Ancak bazen sayfa sayısı çok olduğundan çıktı almak zahmetli oluyor. Bende aşağıdaki kodu kendime uyarlamaya çalıştım. Ancak aşağıdaki gibi hata veriyor. Yanlış olan nedir acaba?


Sub Print_All_Worksheets()
Dim Sh As Worksheet
Dim Arr() As String
Dim N As Integer
N = 0
ilk = InputBox("Yazdirmaya baslanacak Sayfa Numarasi")
N = ilk
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Visible = xlSheetVisible And Sh.Range("F1").Value <> "" Then
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = Sh.Name
End If
Next
With ActiveWorkbook
.Worksheets(Arr).PrintOut 'bu satırda subscript out of range hatası veriyor
End With
End Sub

 

[halit3]

Merhaba

Listede gördüğünüz sayfaları makroyla oluşturduktan sonra raporlarını hazırlayıp çıktılarını alıyorum. Ancak bazen sayfa sayısı çok olduğundan çıktı almak zahmetli oluyor. Bende aşağıdaki kodu kendime uyarlamaya çalıştım. Ancak aşağıdaki gibi hata veriyor. Yanlış olan nedir acaba?


Sub Print_All_Worksheets()
Dim Sh As Worksheet
Dim Arr() As String
Dim N As Integer
N = 0
ilk = InputBox("Yazdirmaya baslanacak Sayfa Numarasi")
N = ilk
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Visible = xlSheetVisible And Sh.Range("F1").Value <> "" Then
N = N + 1
ReDim Preserve Arr(1 To N)
Arr(N) = Sh.Name
End If
Next
With ActiveWorkbook
.Worksheets(Arr).PrintOut 'bu satırda subscript out of range hatası veriyor
End With
End Sub

With ActiveWorkbook
.Worksheets(Arr).PrintOut 'bu satırda subscript out of range hatası veriyor
End With

yukarıdaki bölümün yerine aşağıdaki bölümü ekleyip denermisiniz.

Sheets(Arr).Select
ActiveWindow.SelectedSheets.PrintOut

 

[halit3]

farklı kod

Sub Print_All_Worksheets()

Dim myArray() As Variant
Dim i As Integer
Dim j As Integer
Dim ilk As Integer
j = 0
sayfa = ActiveSheet.Name

ilk = InputBox("Yazdirmaya baslanacak Sayfa Numarasi")
For i = 1 To Sheets.Count
If i >= ilk Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If
Next i
Sheets(myArray).Select
ActiveWindow.SelectedSheets.PrintOut
Sheets(sayfa).Select
End Sub

 

[ockucukay]

Merhaba Halit bey,

İki kodda çalışıyor, çok teşekkür ederim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları da dener misiniz?, alternatif olsun.

Sub Tum_Sayfa_Yazdir()
    ActiveWorkbook.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

 

[ockucukay]

Merhaba Halit bey,

Aşağıdaki kodu 60 sayfa için denedim ama excelde kilitlenme oluyor ve excelden atıyor. Sebebi ne olabilir?

farklı kod

Sub Print_All_Worksheets()

Dim myArray() As Variant
Dim i As Integer
Dim j As Integer
Dim ilk As Integer
j = 0
sayfa = ActiveSheet.Name

ilk = InputBox("Yazdirmaya baslanacak Sayfa Numarasi")
For i = 1 To Sheets.Count
If i >= ilk Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If
Next i
Sheets(myArray).Select
ActiveWindow.SelectedSheets.PrintOut
Sheets(sayfa).Select
End Sub

 

[halit3]

Merhaba Halit bey,

Aşağıdaki kodu 60 sayfa için denedim ama excelde kilitlenme oluyor ve excelden atıyor. Sebebi ne olabilir?

Bir şey söylüyemiyeceğim kodun çalışması gerekiyor

 

[halit3]

Birde böyle dene

Sub Print_All_Worksheets()
Dim i As Integer
Dim ilk As Integer
sayfa = ActiveSheet.Name
ilk = Application.InputBox("Yazdirmaya baslanacak Sayfa Numarasi.", "Başlangıç sayfa numarası", "3", 400, 30, , Type:=1)
If ilk = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
For i = 1 To Sheets.Count
If i >= ilk Then
ActiveWorkbook.Sheets(i).PrintOut
End If
Next i
Sheets(sayfa).Select
End Sub

 

[Necdet]

bizim yanıt güme gitti galiba

 

[ockucukay]

Olur mu öyle şey Necdet hocam

Öncelikle geç cevap verdiğim için özür dilerim. Sizin kodunuz kitaptaki bütün sayfaları yazdırmak için uygun, ama bir kitapta toplam 255 sayfam oluyor. Ben bu sayıya hergün 50-80 arasında sayfa ekleyerek ulaşıyorum. Yani başlangıç sayfasından sonuna kadar kaç sayfa varsa hepsini yazdırıyorum. Kodunuzu bu şekilde çevirebilirsem olacak sanırım.

bizim yanıt güme gitti galiba

Merhaba Halit hocam,

Aşağıdaki kodu denedim, ama bu seferde hiçbirşey yapmadı. Bende F8 ile tek tek kodu işledim ve aşağıdaki yazdığım gibi çalıştı. VBA içinden sayfa numaralarını inputboxa girince (mesela sayfa adı 5108 ama VBA içindeki sayfa no 60) çıktıları aldı. Sanırım sayfa saydırdığımız için (sayfa noları 5000'lerde) ve bir kitapta 255 sayfa bulabildiği için yazdırmıyor. Sayfa adlarını refere edebilir miyiz acaba?

Sub Print_All_Worksheets()
Dim i As Integer
Dim ilk As Integer
Sayfa = ActiveSheet.Name
ilk = Application.InputBox("Yazdirmaya Baslanacak Sayfa Numarasi.", "Başlangıç sayfa numarası", "3", 400, 30, , Type:=1)
If ilk = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
For i = 1 To Sheets.Count
If i >= ilk Then 'bu satırdan sonra ->
ActiveWorkbook.Sheets(i).PrintOut 'bu satırı işlemeden geçiyor ->
End If 'bu satıra geçiyor ->
Next i 'bu satıra geçiyor ve sayfa sayısı kadar devam ettikten sonra makroyu bitiriyor
Sheets(Sayfa).Select
End Sub

Tekrar yardımlarınız için teşekkür ederim.

 

[ockucukay]

Merhaba halit hocam,

bir gelişme var mı acaba?

Olur mu öyle şey Necdet hocam

Öncelikle geç cevap verdiğim için özür dilerim. Sizin kodunuz kitaptaki bütün sayfaları yazdırmak için uygun, ama bir kitapta toplam 255 sayfam oluyor. Ben bu sayıya hergün 50-80 arasında sayfa ekleyerek ulaşıyorum. Yani başlangıç sayfasından sonuna kadar kaç sayfa varsa hepsini yazdırıyorum. Kodunuzu bu şekilde çevirebilirsem olacak sanırım.



Merhaba Halit hocam,

Aşağıdaki kodu denedim, ama bu seferde hiçbirşey yapmadı. Bende F8 ile tek tek kodu işledim ve aşağıdaki yazdığım gibi çalıştı. VBA içinden sayfa numaralarını inputboxa girince (mesela sayfa adı 5108 ama VBA içindeki sayfa no 60) çıktıları aldı. Sanırım sayfa saydırdığımız için (sayfa noları 5000'lerde) ve bir kitapta 255 sayfa bulabildiği için yazdırmıyor. Sayfa adlarını refere edebilir miyiz acaba?

Sub Print_All_Worksheets()
Dim i As Integer
Dim ilk As Integer
Sayfa = ActiveSheet.Name
ilk = Application.InputBox("Yazdirmaya Baslanacak Sayfa Numarasi.", "Başlangıç sayfa numarası", "3", 400, 30, , Type:=1)
If ilk = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
For i = 1 To Sheets.Count
If i >= ilk Then 'bu satırdan sonra ->
ActiveWorkbook.Sheets(i).PrintOut 'bu satırı işlemeden geçiyor ->
End If 'bu satıra geçiyor ->
Next i 'bu satıra geçiyor ve sayfa sayısı kadar devam ettikten sonra makroyu bitiriyor
Sheets(Sayfa).Select
End Sub

Tekrar yardımlarınız için teşekkür ederim.

 

[halit3]

Merhaba halit hocam,

bir gelişme var mı acaba?

Herhalde birikmeden kaynaklanıyor olabilir

ActiveWorkbook.Sheets(i).PrintOut

yukarıdaki koddan sonra aşağıdaki kodu ekle bir deneme yap

Application.Wait (Now + TimeValue("0:00:[COLOR=red]2[/COLOR]"))

bu kod her yazdırmadan sonra iki saniye bekleme yapıyor

 

[ockucukay]

Merhaba Halit hocam,

Kodunuz Sheets.Count mantığına göre doğru çalışıyor ve herhangi bir hata veya birikme yapmıyor.
Sorun şu: Sheets.Count'a göre VBA içinde örneğin sayfa no:10 olan bir sayfanın adı 5103 olsun. Ben inputboxa 5103 sayısını giriyorum, çünkü vba içine girmeden gördüğüm sayfa sayısı 5103. Ama aslında sayfa no:10 olduğundan makro böyle bir sayfa yok olarak algılayıp devam ediyor. Benim yapmak istediğim Sheets.Name'deki numarayı inputboxa gireyim, girdiğim numaradan sonraki tüm sayfaları yazdırsın istiyorum. Umarım daha açıklayıcı olmuştur. Yardımlarınız için tekrar teşekkür ederim.

Herhalde birikmeden kaynaklanıyor olabilir

ActiveWorkbook.Sheets(i).PrintOut

yukarıdaki koddan sonra aşağıdaki kodu ekle bir deneme yap

Application.Wait (Now + TimeValue("0:00:[COLOR=red]2[/COLOR]"))

bu kod her yazdırmadan sonra iki saniye bekleme yapıyor

 

[halit3]

kod

Sub Print_All_Worksheets()
Dim i As Integer, j As Integer, ilk As Integer
ilk = Application.InputBox("Yazdirmaya baslanacak sayfa adı.", "Başlangıç sayfa adı", "3", 400, 30, , Type:=1)
If ilk = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
For j = 1 To Sheets.Count
If Sheets(j).Name = ilk Then
For i = j To Sheets.Count
ActiveWorkbook.Sheets(i).PrintOut
Next i
Exit For
End If
Next j
 
End Sub

 

[ockucukay]

Merhaba halit hocam

Değişen birşey olmadı, diğer kodla aynı mantıkta çalışıyor. Yinede emekleriniz için teşekkür ederim.

kod

Sub Print_All_Worksheets()
Dim i As Integer, j As Integer, ilk As Integer
ilk = Application.InputBox("Yazdirmaya baslanacak sayfa adı.", "Başlangıç sayfa adı", "3", 400, 30, , Type:=1)
If ilk = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
For j = 1 To Sheets.Count
If Sheets(j).Name = ilk Then
For i = j To Sheets.Count
ActiveWorkbook.Sheets(i).PrintOut
Next i
Exit For
End If
Next j
 
End Sub

 

[halit3]

Merhaba halit hocam

Değişen birşey olmadı, diğer kodla aynı mantıkta çalışıyor. Yinede emekleriniz için teşekkür ederim.

14 nolu mesajdaki kod

Başlangıç sayfa (ilk) adını yazıyorsunuz bu sayfanın sıralamasını kendisi buluyor ve devamındada son sayfaya kadar yazdırıyor.

 

[ockucukay]

Merhaba Halit hocam,

Söylediğinizde haklısınız. Ancak benim eksik belirttiğim konu, kodun "ilk" olarak aldığı değer; sayfanın adı olan "5103" değil, VBA içinden görülebilen sayfanın gerçek numarası olan "sayfa 10"dur. Çünkü kodda "Sheets.Count" kullanılıyor. Ben inputboxa "5103" girince yazdırma işlemi yapılsın istiyordum. Umarım anlatabilmişimdir, sürçü lisan ettiysem affola...

14 nolu mesajdaki kod

Başlangıç sayfa (ilk) adını yazıyorsunuz bu sayfanın sıralamasını kendisi buluyor ve devamındada son sayfaya kadar yazdırıyor.

 

[halit3]

Merhaba Halit hocam,

Söylediğinizde haklısınız. Ancak benim eksik belirttiğim konu, kodun "ilk" olarak aldığı değer; sayfanın adı olan "5103" değil, VBA içinden görülebilen sayfanın gerçek numarası olan "sayfa 10"dur. Çünkü kodda "Sheets.Count" kullanılıyor. Ben inputboxa "5103" girince yazdırma işlemi yapılsın istiyordum. Umarım anlatabilmişimdir, sürçü lisan ettiysem affola...

Bir birimizi anlıyamadık siz inbutboxa 5103 girip denedinizmi 14 nolu mesajdaki koda.?

 

[halit3]

Bu kod da mesaj olarak uyarıyor.

Sub Print_All_Worksheets()
Dim i As Integer, j As Integer, ilk As String
ilk = InputBox("Sutun numarasını giriniz.", "UYARI!", "5103")
If ilk = "" Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
For j = 1 To Sheets.Count
If Sheets(j).Name = ilk Then
MsgBox Sheets(j).Name & "  Bu sayfadan sonraki sayfalar yazdırılacak " & Chr(10) & j & " - " & Sheets.Count
For i = j + 1 To Sheets.Count
ActiveWorkbook.Sheets(i).PrintOut
Next i
Exit For
End If
Next j
 
End Sub

 

[ockucukay]

Merhaba Halit hocam,

VBA'da adım adım makronun yaptığını izleyince farkedememişim. Bundan dolayı sizden özür diliyorum. Her iki kodda çok güzel çalışıyor. Emeğinize sağlık....