Klasördeki bütün excel çalışmaları yazdır. ??

[blackkugu]

Merhaba arkadaşlar 2023 adında bir klasörüm var ve içerisinde 72 tane excel dosyası mevcut tek tek yazdır demektense bunları topluca nasıl yazdırabilirim.
excel dosya isimleri farklı fakat içerikte Sayfa1 adları hepsinde aynı sadece Sayfa1 deki veriler yazdırılsın. Olabilirse Sayfa1 deki verini Sayfa oranı %10 daha yani birazcık daha küçük yazdırılabilir mi ?
tşk ederim.

 

[RBozkurt]

Deneyiniz,
AI üründür denemedim.

Makroyu bir dosyaya ekleyin; bu dosya 2023 klasörü ile aynı klasör içinde olsun.

Sub KlasordekiExcelleriYazdir()
    Dim MyFolder As String
    Dim MyFile As String
    Dim wb As Workbook
    
    Application.ScreenUpdating = False
    
    MyFolder = ThisWorkbook.Path & "\2023\"
    MyFile = Dir(MyFolder & "*.xls*")
    
    Do While MyFile <> ""
        Set wb = Workbooks.Open(Filename:=MyFolder & MyFile)
        With wb.Sheets("Sayfa1").PageSetup
            .Zoom = False
            .FitToPagesTall = 1
            .FitToPagesWide = 1
            .Zoom = 90 ' Sayfa oranı %10 daha küçük
        End With
        ActiveSheet.PrintOut Copies:=1
        wb.Close SaveChanges:=False
        MyFile = Dir
    Loop
    
    Application.ScreenUpdating = True
    
End Sub

 

[blackkugu]

Sub Toplu_Yazdırma()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each dosya In CreateObject("scripting.filesystemobject").getfolder(ThisWorkbook.Path).Files
If dosya.Name <> ThisWorkbook.Name And VBA.Left(dosya.Name, 2) <> "~$" Then
Set dosyaac = Workbooks.Open(dosya)
dosyaac.Sheets("Sayfa1").Range("a1:m27").PrintOut
dosyaac.Close , True
End If
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

sanırım bu kod işimi görür tşk ler

 

[blackkugu]

Deneyiniz,
AI üründür denemedim.

Makroyu bir dosyaya ekleyin; bu dosya 2023 klasörü ile aynı klasör içinde olsun.

Sub KlasordekiExcelleriYazdir()
    Dim MyFolder As String
    Dim MyFile As String
    Dim wb As Workbook
   
    Application.ScreenUpdating = False
   
    MyFolder = ThisWorkbook.Path & "\2023\"
    MyFile = Dir(MyFolder & "*.xls*")
   
    Do While MyFile <> ""
        Set wb = Workbooks.Open(Filename:=MyFolder & MyFile)
        With wb.Sheets("Sayfa1").PageSetup
            .Zoom = False
            .FitToPagesTall = 1
            .FitToPagesWide = 1
            .Zoom = 90 ' Sayfa oranı %10 daha küçük
        End With
        ActiveSheet.PrintOut Copies:=1
        wb.Close SaveChanges:=False
        MyFile = Dir
    Loop
   
    Application.ScreenUpdating = True
   
End Sub

Çok tşk ederim bende bulmaya çalıştım. Sizin koduda deneyeceğim.

 

[blackkugu]

Bir kaç çıktı aldım eline sağlık çok işime yarayacak zahmetten kurtardınız.
Çıktılarda küçültme işleminde hizalamayı sayfa ortasına yapılabilir mi ? makro ile
veriler A4 sol tarafa göre küçülmüş olmuyorsa yine bu şekilde kalsın.
Tekrar tşk ederim.

 

[RBozkurt]

1 yerine False yazıp deneyin

.FitToPagesTall = 1
.FitToPagesWide = 1

 

[blackkugu]

1 yerine False yazıp deneyin

.FitToPagesTall = 1
.FitToPagesWide = 1

test ettim a4 e ortalı basmadı.

 

[blackkugu]

test ettim a4 e ortalı basmadı.

acaba zoom oranı 90 yaptığımız için olmasın. hani %10 küçülttük. O zaman kalsın böyle yine de tşk ederim

 

[blackkugu]

.CenterHorizontally = True

bu şekilde düzelttim

 

[RBozkurt]

Kolay gelsin.