Excel'den Belli Bir Klasördeki Tüm Word Dosyalarının Sayfa Yapısını Değiştirmek

1 2
17/12/2022, 22:50

ras.sag

(17/12/2022, 22:42)berduş yazdı: Kodu asagidaki gibi, parantezleri kaldırarak, düzenleyip dener misiniz
SetupPage Dosya, tmpAppWord

Çok sağolun şimdi azaltılmış dosya sayısı ile sorunsuz olarak çalıştı. Ama ayrı bir şey de sormak istiyorum: Kodu oradan buradan alıntılarla oluşturduğum ve tümünü değerlendirmeye bilgim yetmediğinden öylecene bıraktığım ama aklımca lüzumsuz satırların kodda yer aldığını tahmin ediyorum bu konuda bir şey söyleyebilirseniz sevinirim.
17/12/2022, 22:57

berduş

Onerebilcegim Fazla birsey yok aslinda ama Application.CutCopyMode = False kodu döngü içine yazıldığı için boş yere sürekli çalışıyor o satırı döngüden önceye taşıyabilirsiniz
2. Olarak da Application.CutCopyMode = False kodu excelde seçme modunu devre dışı bırakmak için kullanılır dolaysıyla ilkinde pasif yapılıyorsa diğerinde açılmalıdır yani sondaki Application.CutCopyMode = true olmalı
17/12/2022, 23:02

ras.sag

(17/12/2022, 22:57)berduş yazdı: Onerebilcegim Fazla birsey yok aslinda ama Application.CutCopyMode = False kodu döngü içine yazıldığı için boş yere sürekli çalışıyor o satırı döngüden önceye taşıyabilirsiniz
2. Olarak da Application.CutCopyMode = False kodu excelde seçme modunu devre dışı bırakmak için kullanılır dolaysıyla ilkinde pasif yapılıyorsa diğerinde açılmalıdır yani sondaki Application.CutCopyMode = true olmalı

Çok sağolun sayenizde başa çıkamadığım bir sorundan kurtuldum. Kodun son halini de buraya koyayım da belki biri yararlanır.
Kod:
Option Explicit
Dim Dosya As String

Sub word_sayfa_yapisi()
Dim s As Long
Dim DosyaSay As Long
DosyaSay = WorksheetFunction.CountA(Range("a2:a2000"))
Dim tmpAppWord As Word.Application
Set tmpAppWord = CreateObject("Word.Application")
For s = 1 To DosyaSay
Dosya = Range("A" & 1 + s).Value
SetupPage Dosya, tmpAppWord
        Dosya = ""
    Next s
    tmpAppWord.Quit
    Set tmpAppWord = Nothing
End Sub

Sub SetupPage(Dosya As String, AppWord As Object)
    AppWord.Documents.Open Dosya
    AppWord.Visible = True
    With AppWord.ActiveDocument.PageSetup
        .PageWidth = CentimetersToPoints(9)
        .PageHeight = CentimetersToPoints(29.7)
        .TopMargin = CentimetersToPoints(0.6)
        .BottomMargin = CentimetersToPoints(0.6)
        .LeftMargin = CentimetersToPoints(0.6)
        .RightMargin = CentimetersToPoints(0.6)
    End With
    AppWord.ActiveDocument.Save
    AppWord.ActiveDocument.Close
    
End Sub
17/12/2022, 23:06

berduş

Kodun son halini paylaştığınız icin teşekkürler
Ben de 2. mesajdaki kodu yeniden düzenlemiştim)

Aslında önce a2:a2000 aralığındaki son satır bulunup diziye aktarılarak yapılsa daha hızlı olabilir
1 2