Skip to main content

AccessTr.neT


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

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

Çözüldü #1
Şu kod ile Excel içinde listesi bulunan belli bir klasördeki word dosyalarının sayfa yapılarını değiştiriyorum. Kod bu haliyle ilk dosyayı değiştiriyor, dosyayı ve word'ü kapatıyor, ikinci dosyayı açınca ".PageWidth = CentimetersToPoints(9)" satırında takılıyor. "AppWord.Quit" kodunu devre dışı bırakırsam tüm dosyalarda gereğini yapıyor ama dosya sayısı çok fazla olduğundan her dosya başına bir word uygulaması açık kaldığından belli bir noktadan sonra bellek yetmiyor.
Nerde hata yapıyorum acaba?

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"))
For s = 1 To DosyaSay
Dosya = Range("A" & 1 + s).Value
SetupPage (Dosya)
        Dosya = ""
    Application.CutCopyMode = False
    Next s
   Range("A1").Select
   Application.CutCopyMode = False
End Sub

Sub SetupPage(Dosya As String)
Dim AppWord As Word.Application
    Set AppWord = CreateObject("Word.Application")
    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
    AppWord.Quit
    Set AppWord = Nothing
End Sub

Cevapla
#2
Kodu aşağıdaki gibi düzenleyip dener misiniz?
Deneme imkanım olmadı teorik
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")
AppWord.Visible = True

Application.CutCopyMode = False
For s = 1 To DosyaSay
Dosya = Range("A" & 1 + s).Value
SetupPage Dosya, tmpAppWord
        Dosya = ""
Next s
    TmpAppWord.Quit
    Set tmpAppWord = Nothing
   Range("A1").Select
   Application.CutCopyMode = False
End Sub

Sub SetupPage(Dosya As String, AppWord as object)
    AppWord.Documents.Open Dosya
   
    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
Cevapla
#3
(17/12/2022, 22:13)berduş yazdı: Kodu aşağıdaki gibi düzenleyip dener misiniz?
Deneme imkanım olmadı teorik
Option Explicit
Dim Dosya As String

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

Sub SetupPage(Dosya As String, AppWord as object)
'Dim AppWord As Word.Application
'  Set AppWord = CreateObject("Word.Application")
    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

Öncelikle ilginize teşekkür ederim. Vba kod sayfasında "Compile error: Variable not defined" mesajı verip "tmpAppWord =" metninin üzerini işaretliyor.
Cevapla
#4
En başta Option Explicit satırı olduğundan önce tmpAppWord tanımlanmalı. Bu hata ondan kaynaklanıyor. Set tmpAppWord = CreateObject("Word.Application") satırının üstüne
Dim tmpAppWord As Word.Application
kodunu ekler misiniz?
Cevapla
#5
Şimdi "SetupPage (Dosya, tmpAppWord)" satırında "syntax error" hatası veriyor.
Cevapla
#6
Kodu asagidaki gibi, parantezleri kaldırarak, düzenleyip dener misiniz
SetupPage Dosya, tmpAppWord
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task