(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.
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, 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
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