Soru VBA Word Doldurma Hatası Hakkında

halit3 · 12 Mart 2022

Birde bu dosyayı irdeleyiniz.

deneme.rar dosyasını indir - download

deneme.rar dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

RBozkurt · 27 Nisan 2022

Merhaba

18. mesajdaki kodu;
Alttaki kod içerisinde .docx uzantısını .pdf yapınca oluşan dosya hata vermektedir.
PDF kayıt için nasıl bir yol izlenmelidir?

C++:

Next X
dosyayol = yoll & DosyaAdi & ".docx"
Uzlasma.SaveAs dosyayol

Korhan Ayhan · 27 Nisan 2022

MAKRO KAYDET yöntemini kullanarak bu kodları kolaylıkla elde edebilirsiniz.

RBozkurt · 27 Nisan 2022

Makro kaydet ile ve internetten bulunan kod ile de denedim halledemedim malesef.

C++:

Uzlasma.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    dosyayol & ".pdf" _
    , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

C++:

dosyayol = yoll & DosyaAdi & ".pdf"


    Uzlasma.ExportAsFixedFormat OutputFileName:= _
        dosyayol, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

Korhan Ayhan · 27 Nisan 2022

Boş bir word dosyası açtım. Makro Kaydet tuşuna tıkladım.

Belgeye birkaç kelime yazdım.
Farklı kaydet menüsünü kullanarak PDF formatında masaüstüne kayıt ettim.
Sonra makro kadyını durdurdum.

Oluşan koda sadece dosya adını tanımladım. Bende sorunsuz çalışıyor.

C++:

Option Explicit

Sub Macro1()
    Dim Dosya As String
    
    Dosya = "C:\Users\Admin\Desktop\Deneme.pdf"
    
    ActiveDocument.ExportAsFixedFormat OutputFileName:=Dosya, _
    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
    Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub

RBozkurt · 27 Nisan 2022

Korhan Bey yukarda belirttiğim makro word değil ama.
Excel sayfasında tabloda veriler var. wordu açıyor, bookmark kısmındaki tanımlamaya göre doldurup kaydediyor.

Word ile işlemi yapmıyorum. Excel yapıyor.

Korhan Ayhan · 27 Nisan 2022

Amaç açık olan word dosyasını PDF olarak kayıt etmek değil mi?

Eğer öyle ise kodların işe yaraması gerekir.

RBozkurt · 27 Nisan 2022

Makro çalışınca excel sayfasında bulunan verileri baz alarak;

önce kendisi word'de belirdediğim şablonu açıyor
Sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"

Bu şablona bookmark kısmından tanımlama yaptım. Yaklaşık 25 adet.
Kendisi dolduruyor ve kaydediyor. Ama nasıl kaydediyor bilmiyorum.

Son hali alttaki gibidir.
.docx'i .pdf yaptım. Dosya oluşuyor fakat arızalı bir dosya oluşuyor.

C++:

Sub ZZZZ_Uzlaşma_Hazırla()
Dim Uzlasma As Word.Document

Set R1 = ThisWorkbook.Worksheets("Tutanak")
Set R2 = ThisWorkbook.Worksheets("ProjeBilgileri")
sonsatir = R1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
yoll = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

Sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"

kaydet2 = ThisWorkbook.Path & "\Tutanak\"
kaydet1 = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

If Len(Dir(kaydet2, vbDirectory)) = 0 Then MkDir kaydet2
If Len(Dir(kaydet1, vbDirectory)) = 0 Then MkDir kaydet1

For i = 2 To sonsatir
Set msword = CreateObject("word.application")
msword.Visible = True
Set Uzlasma = msword.Documents.Open(Filename:=Sablon, ReadOnly:=False)
'TAŞINMAZ SATIRLARI
Uzlasma.Bookmarks("İl").Range = R1.Cells(i, "C")                'İL
Uzlasma.Bookmarks("İlçe").Range = R1.Cells(i, "D")              'İLÇE
Uzlasma.Bookmarks("Mahalle").Range = R1.Cells(i, "E")           'MAHALLE
Uzlasma.Bookmarks("Ada").Range = R1.Cells(i, "F")               'ADA
Uzlasma.Bookmarks("Parsel").Range = R1.Cells(i, "G")            'PARSEL
Uzlasma.Bookmarks("YüzÖlçüm").Range = R1.Cells(i, "L")          'YÖZ ÖLÇÜMÜ
'MALİK SATIRLARI
Uzlasma.Bookmarks("KDN").Range = R1.Cells(i, "B")               'KDN
Uzlasma.Bookmarks("TC").Range = R1.Cells(i, "S")                'TC
Uzlasma.Bookmarks("AdıSoyadı").Range = R1.Cells(i, "H")         'ADI SOYADI
Uzlasma.Bookmarks("AdıSoyadı2").Range = R1.Cells(i, "H")        'ADI SOYADI 2
Uzlasma.Bookmarks("BabaAdı").Range = R1.Cells(i, "I")           'BABA ADI
Uzlasma.Bookmarks("Cins").Range = R1.Cells(i, "K")              'CİNS
Uzlasma.Bookmarks("DoğumTarihi").Range = R1.Cells(i, "T")       'DOĞUM TARİHİ
Uzlasma.Bookmarks("Hissesi").Range = R1.Cells(i, "J")           'HİSSE
'BEDEL SATIRLARI
Uzlasma.Bookmarks("İstimlakBedel").Range = Format(R1.Cells(i, "P"), "0.00")      'KAM. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("İrtifakBedel").Range = Format(R1.Cells(i, "Q"), "0.00")       'İRTİFAK. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("ToplamBedel").Range = Format(R1.Cells(i, "R"), "0.00")        'TOPLAM BEDEL
'KAMULAŞTIRMA ALANLARI
Uzlasma.Bookmarks("İrtifak").Range = Format(R1.Cells(i, "N"), "0.00")           'İRTİFAK
Uzlasma.Bookmarks("İrtifak2").Range = Format(R1.Cells(i, "N"), "0.00")          'İRTİFAK ALANI (AÇIKLAMA)
Uzlasma.Bookmarks("İstimlak").Range = Format(R1.Cells(i, "M"), "0.00")          'KAM. ALAN
Uzlasma.Bookmarks("İstimlak2").Range = Format(R1.Cells(i, "M"), "0.00")         'KAM. ALAN (AÇIKLAMA)

'Alttaki satırda çağrılacak veriler tüm sayfalar için sabittir.
Uzlasma.Bookmarks("TesisBilgisi").Range = R2.Cells(1, 2) 'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKTarih").Range = R2.Cells(2, 2) 'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKSayı").Range = R2.Cells(3, 2) 'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

'Komisyon Üyeleri
Uzlasma.Bookmarks("Baskan").Range = R2.Cells(5, 2)          'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("BaskanU").Range = R2.Cells(6, 2)         'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1").Range = R2.Cells(7, 2)            'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1U").Range = R2.Cells(8, 2)           'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2").Range = R2.Cells(9, 2)            'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2U").Range = R2.Cells(10, 2)          'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

DosyaAdi = R1.Cells(i, "B") & " - " & R1.Cells(i, "H") & R1.Cells(i, "J") & " (TC " & R1.Cells(i, "S") & ")" & " (Uzlaşma)"
MyArray = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
For x = LBound(MyArray) To UBound(MyArray)
    DosyaAdi = Replace(DosyaAdi, MyArray(x), "_", 1)
Next x
dosyayol = yoll & DosyaAdi & ".docx"
Uzlasma.SaveAs dosyayol

Uzlasma.Close
msword.Quit SaveChanges:=wdSaveChanges
Next i

End Sub

Korhan Ayhan · 27 Nisan 2022

Bu kodu deneyebileceğimiz örnek dosyalar varsa paylaşırmısınız.

necati · 27 Nisan 2022

Oluşan Pdf'ler bende problemsiz açılıyor.

Kod:

Sub ZZZZ_Uzlaşma_HazırlaRBozkurt()
Dim Uzlasma As Word.Document

Set R1 = ThisWorkbook.Worksheets("Kaynak1")
Set R2 = ThisWorkbook.Worksheets("ProjeBilgileri")
sonsatir = R1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
yoll = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"

kaydet2 = ThisWorkbook.Path & "\Tutanak\"
kaydet1 = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

If Len(Dir(kaydet2, vbDirectory)) = 0 Then MkDir kaydet2
If Len(Dir(kaydet1, vbDirectory)) = 0 Then MkDir kaydet1

For i = 2 To sonsatir
Set msword = CreateObject("word.application")
msword.Visible = True
Set Uzlasma = msword.Documents.Open(Filename:=sablon, ReadOnly:=False)
'TAŞINMAZ SATIRLARI
Uzlasma.Bookmarks("İl").Range = R1.Cells(i, "C")                'İL
Uzlasma.Bookmarks("İlçe").Range = R1.Cells(i, "D")              'İLÇE
Uzlasma.Bookmarks("Mahalle").Range = R1.Cells(i, "E")           'MAHALLE
Uzlasma.Bookmarks("Ada").Range = R1.Cells(i, "F")               'ADA
Uzlasma.Bookmarks("Parsel").Range = R1.Cells(i, "G")            'PARSEL
Uzlasma.Bookmarks("YüzÖlçüm").Range = R1.Cells(i, "L")          'YÖZ ÖLÇÜMÜ
'MALİK SATIRLARI
Uzlasma.Bookmarks("KDN").Range = R1.Cells(i, "B")               'KDN
Uzlasma.Bookmarks("TC").Range = R1.Cells(i, "S")                'TC
Uzlasma.Bookmarks("AdıSoyadı").Range = R1.Cells(i, "H")         'ADI SOYADI
Uzlasma.Bookmarks("AdıSoyadı2").Range = R1.Cells(i, "H")        'ADI SOYADI 2
Uzlasma.Bookmarks("BabaAdı").Range = R1.Cells(i, "I")           'BABA ADI
Uzlasma.Bookmarks("Cins").Range = R1.Cells(i, "K")              'CİNS
Uzlasma.Bookmarks("DoğumTarihi").Range = R1.Cells(i, "T")       'DOĞUM TARİHİ
Uzlasma.Bookmarks("Hissesi").Range = R1.Cells(i, "J")           'HİSSE
'BEDEL SATIRLARI
Uzlasma.Bookmarks("İstimlakBedel").Range = Format(R1.Cells(i, "P"), "0.00")      'KAM. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("İrtifakBedel").Range = Format(R1.Cells(i, "Q"), "0.00")       'İRTİFAK. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("ToplamBedel").Range = Format(R1.Cells(i, "R"), "0.00")        'TOPLAM BEDEL
'KAMULAŞTIRMA ALANLARI
Uzlasma.Bookmarks("İrtifak").Range = Format(R1.Cells(i, "N"), "0.00")           'İRTİFAK
Uzlasma.Bookmarks("İrtifak2").Range = Format(R1.Cells(i, "N"), "0.00")          'İRTİFAK ALANI (AÇIKLAMA)
Uzlasma.Bookmarks("İstimlak").Range = Format(R1.Cells(i, "M"), "0.00")          'KAM. ALAN
Uzlasma.Bookmarks("İstimlak2").Range = Format(R1.Cells(i, "M"), "0.00")         'KAM. ALAN (AÇIKLAMA)

'Alttaki satırda çağrılacak veriler tüm sayfalar için sabittir.
Uzlasma.Bookmarks("TesisBilgisi").Range = R2.Cells(1, 2) 'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKTarih").Range = R2.Cells(2, 2) 'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKSayı").Range = R2.Cells(3, 2) 'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

'Komisyon Üyeleri
Uzlasma.Bookmarks("Baskan").Range = R2.Cells(5, 2)          'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("BaskanU").Range = R2.Cells(6, 2)         'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1").Range = R2.Cells(7, 2)            'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1U").Range = R2.Cells(8, 2)           'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2").Range = R2.Cells(9, 2)            'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2U").Range = R2.Cells(10, 2)          'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

DosyaAdi = R1.Cells(i, "B") & " - " & R1.Cells(i, "H") & R1.Cells(i, "J") & " (TC " & R1.Cells(i, "S") & ")" & " (Uzlaşma)"
MyArray = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
For x = LBound(MyArray) To UBound(MyArray)
    DosyaAdi = Replace(DosyaAdi, MyArray(x), "_", 1)
Next x
dosyayol = yoll & DosyaAdi & ".pdf"
'Uzlasma.SaveAs dosyayol

    ActiveDocument.ExportAsFixedFormat OutputFileName:=dosyayol _
        , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
    ShowVisualBasicEditor = True



Uzlasma.Close
msword.Quit SaveChanges:=wdSaveChanges
Next i

End Sub

RBozkurt · 27 Nisan 2022

necati' Alıntı:

Oluşan Pdf'ler bende problemsiz açılıyor.

Kod:

Sub ZZZZ_Uzlaşma_HazırlaRBozkurt()
Dim Uzlasma As Word.Document

Set R1 = ThisWorkbook.Worksheets("Kaynak1")
Set R2 = ThisWorkbook.Worksheets("ProjeBilgileri")
sonsatir = R1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
yoll = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"

kaydet2 = ThisWorkbook.Path & "\Tutanak\"
kaydet1 = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

If Len(Dir(kaydet2, vbDirectory)) = 0 Then MkDir kaydet2
If Len(Dir(kaydet1, vbDirectory)) = 0 Then MkDir kaydet1

For i = 2 To sonsatir
Set msword = CreateObject("word.application")
msword.Visible = True
Set Uzlasma = msword.Documents.Open(Filename:=sablon, ReadOnly:=False)
'TAŞINMAZ SATIRLARI
Uzlasma.Bookmarks("İl").Range = R1.Cells(i, "C")                'İL
Uzlasma.Bookmarks("İlçe").Range = R1.Cells(i, "D")              'İLÇE
Uzlasma.Bookmarks("Mahalle").Range = R1.Cells(i, "E")           'MAHALLE
Uzlasma.Bookmarks("Ada").Range = R1.Cells(i, "F")               'ADA
Uzlasma.Bookmarks("Parsel").Range = R1.Cells(i, "G")            'PARSEL
Uzlasma.Bookmarks("YüzÖlçüm").Range = R1.Cells(i, "L")          'YÖZ ÖLÇÜMÜ
'MALİK SATIRLARI
Uzlasma.Bookmarks("KDN").Range = R1.Cells(i, "B")               'KDN
Uzlasma.Bookmarks("TC").Range = R1.Cells(i, "S")                'TC
Uzlasma.Bookmarks("AdıSoyadı").Range = R1.Cells(i, "H")         'ADI SOYADI
Uzlasma.Bookmarks("AdıSoyadı2").Range = R1.Cells(i, "H")        'ADI SOYADI 2
Uzlasma.Bookmarks("BabaAdı").Range = R1.Cells(i, "I")           'BABA ADI
Uzlasma.Bookmarks("Cins").Range = R1.Cells(i, "K")              'CİNS
Uzlasma.Bookmarks("DoğumTarihi").Range = R1.Cells(i, "T")       'DOĞUM TARİHİ
Uzlasma.Bookmarks("Hissesi").Range = R1.Cells(i, "J")           'HİSSE
'BEDEL SATIRLARI
Uzlasma.Bookmarks("İstimlakBedel").Range = Format(R1.Cells(i, "P"), "0.00")      'KAM. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("İrtifakBedel").Range = Format(R1.Cells(i, "Q"), "0.00")       'İRTİFAK. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("ToplamBedel").Range = Format(R1.Cells(i, "R"), "0.00")        'TOPLAM BEDEL
'KAMULAŞTIRMA ALANLARI
Uzlasma.Bookmarks("İrtifak").Range = Format(R1.Cells(i, "N"), "0.00")           'İRTİFAK
Uzlasma.Bookmarks("İrtifak2").Range = Format(R1.Cells(i, "N"), "0.00")          'İRTİFAK ALANI (AÇIKLAMA)
Uzlasma.Bookmarks("İstimlak").Range = Format(R1.Cells(i, "M"), "0.00")          'KAM. ALAN
Uzlasma.Bookmarks("İstimlak2").Range = Format(R1.Cells(i, "M"), "0.00")         'KAM. ALAN (AÇIKLAMA)

'Alttaki satırda çağrılacak veriler tüm sayfalar için sabittir.
Uzlasma.Bookmarks("TesisBilgisi").Range = R2.Cells(1, 2) 'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKTarih").Range = R2.Cells(2, 2) 'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKSayı").Range = R2.Cells(3, 2) 'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

'Komisyon Üyeleri
Uzlasma.Bookmarks("Baskan").Range = R2.Cells(5, 2)          'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("BaskanU").Range = R2.Cells(6, 2)         'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1").Range = R2.Cells(7, 2)            'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1U").Range = R2.Cells(8, 2)           'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2").Range = R2.Cells(9, 2)            'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2U").Range = R2.Cells(10, 2)          'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

DosyaAdi = R1.Cells(i, "B") & " - " & R1.Cells(i, "H") & R1.Cells(i, "J") & " (TC " & R1.Cells(i, "S") & ")" & " (Uzlaşma)"
MyArray = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
For x = LBound(MyArray) To UBound(MyArray)
    DosyaAdi = Replace(DosyaAdi, MyArray(x), "_", 1)
Next x
dosyayol = yoll & DosyaAdi & ".pdf"
'Uzlasma.SaveAs dosyayol

    ActiveDocument.ExportAsFixedFormat OutputFileName:=dosyayol _
        , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False
    ShowVisualBasicEditor = True



Uzlasma.Close
msword.Quit SaveChanges:=wdSaveChanges
Next i

End Sub

Merhaba
Resimdeki hatayı almaktayım

RBozkurt · 27 Nisan 2022

Korhan Ayhan' Alıntı:
Bu kodu deneyebileceğimiz örnek dosyalar varsa paylaşırmısınız.

Merhaba @Korhan Ayhan bey
Örnek ektedir.
Makroyu çalıştırın word olarak oluşacaktır.
Amaç pdf olarak oluşturmaktır. Teşekkürler.

halit3 · 27 Nisan 2022

Set msword = CreateObject("word.application")

Yukarıdaki bölümü aşağıdaki bölüm ile değiştirip denermisiniz

Set msword =CreateObject("Word.Application.16")

halit3 · 27 Nisan 2022

Kısıtlı bilgisayarda kodlar çalışmıyor olabilir aşağıdaki kod çalışıyor.

Rich (BB code):

dosyayol = yoll & DosyaAdi & ".docx"
Uzlasma.SaveAs dosyayol
dosyayol = yoll & DosyaAdi & ".pdf"

msword.ActiveDocument.ExportAsFixedFormat OutputFileName:=dosyayol, ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
        CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=False, UseISO19005_1:=False

Uzlasma.Close
msword.Quit SaveChanges:=wdSaveChanges
Next i

Korhan Ayhan · 27 Nisan 2022

Ben de aşağıdaki şekilde sorun çıkmadan çalıştı.

C++:

Sub ZZZZ_Uzlaşma_Hazırla()
Dim Uzlasma As Word.Document

Set R1 = ThisWorkbook.Worksheets("Kaynak1")
Set R2 = ThisWorkbook.Worksheets("ProjeBilgileri")
sonsatir = R1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
yoll = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

Sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"

kaydet2 = ThisWorkbook.Path & "\Tutanak\"
kaydet1 = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

If Len(Dir(kaydet2, vbDirectory)) = 0 Then MkDir kaydet2
If Len(Dir(kaydet1, vbDirectory)) = 0 Then MkDir kaydet1

For i = 2 To sonsatir
Set msword = CreateObject("word.application")
msword.Visible = True
Set Uzlasma = msword.Documents.Open(Filename:=Sablon, ReadOnly:=False)
'TAŞINMAZ SATIRLARI
Uzlasma.Bookmarks("İl").Range = R1.Cells(i, "C")                'İL
Uzlasma.Bookmarks("İlçe").Range = R1.Cells(i, "D")              'İLÇE
Uzlasma.Bookmarks("Mahalle").Range = R1.Cells(i, "E")           'MAHALLE
Uzlasma.Bookmarks("Ada").Range = R1.Cells(i, "F")               'ADA
Uzlasma.Bookmarks("Parsel").Range = R1.Cells(i, "G")            'PARSEL
Uzlasma.Bookmarks("YüzÖlçüm").Range = R1.Cells(i, "L")          'YÖZ ÖLÇÜMÜ
'MALİK SATIRLARI
Uzlasma.Bookmarks("KDN").Range = R1.Cells(i, "B")               'KDN
Uzlasma.Bookmarks("TC").Range = R1.Cells(i, "S")                'TC
Uzlasma.Bookmarks("AdıSoyadı").Range = R1.Cells(i, "H")         'ADI SOYADI
Uzlasma.Bookmarks("AdıSoyadı2").Range = R1.Cells(i, "H")        'ADI SOYADI 2
Uzlasma.Bookmarks("BabaAdı").Range = R1.Cells(i, "I")           'BABA ADI
Uzlasma.Bookmarks("Cins").Range = R1.Cells(i, "K")              'CİNS
Uzlasma.Bookmarks("DoğumTarihi").Range = R1.Cells(i, "T")       'DOĞUM TARİHİ
Uzlasma.Bookmarks("Hissesi").Range = R1.Cells(i, "J")           'HİSSE
'BEDEL SATIRLARI
Uzlasma.Bookmarks("İstimlakBedel").Range = Format(R1.Cells(i, "P"), "0.00")      'KAM. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("İrtifakBedel").Range = Format(R1.Cells(i, "Q"), "0.00")       'İRTİFAK. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("ToplamBedel").Range = Format(R1.Cells(i, "R"), "0.00")        'TOPLAM BEDEL
'KAMULAŞTIRMA ALANLARI
Uzlasma.Bookmarks("İrtifak").Range = Format(R1.Cells(i, "N"), "0.00")           'İRTİFAK
Uzlasma.Bookmarks("İrtifak2").Range = Format(R1.Cells(i, "N"), "0.00")          'İRTİFAK ALANI (AÇIKLAMA)
Uzlasma.Bookmarks("İstimlak").Range = Format(R1.Cells(i, "M"), "0.00")          'KAM. ALAN
Uzlasma.Bookmarks("İstimlak2").Range = Format(R1.Cells(i, "M"), "0.00")         'KAM. ALAN (AÇIKLAMA)

'Alttaki satırda çağrılacak veriler tüm sayfalar için sabittir.
Uzlasma.Bookmarks("TesisBilgisi").Range = R2.Cells(1, 2) 'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKTarih").Range = R2.Cells(2, 2) 'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKSayı").Range = R2.Cells(3, 2) 'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

'Komisyon Üyeleri
Uzlasma.Bookmarks("Baskan").Range = R2.Cells(5, 2)          'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("BaskanU").Range = R2.Cells(6, 2)         'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1").Range = R2.Cells(7, 2)            'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1U").Range = R2.Cells(8, 2)           'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2").Range = R2.Cells(9, 2)            'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2U").Range = R2.Cells(10, 2)          'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

DosyaAdi = R1.Cells(i, "B") & " - " & R1.Cells(i, "H") & R1.Cells(i, "J") & " (TC " & R1.Cells(i, "S") & ")" & " (Uzlaşma)"
MyArray = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
For x = LBound(MyArray) To UBound(MyArray)
    DosyaAdi = Replace(DosyaAdi, MyArray(x), "_", 1)
Next x
dosyayol = yoll & DosyaAdi & ".pdf"
Uzlasma.ExportAsFixedFormat OutputFileName:=dosyayol _
    , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
    Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
    CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
    BitmapMissingFonts:=False, UseISO19005_1:=False
Uzlasma.Close False
msword.Quit SaveChanges:=wdSaveChanges
Next i
End Sub

RBozkurt · 27 Nisan 2022

Aslında pcler kısıtlı ama lokal admin hesabı bana ait. Kısıtlamaya takılmaması lazımdı.

33. Mesajdaki islemi yapıp ardından alttaki şekilde deneyeyim.

necati · 27 Nisan 2022

Aşağıdaki şekilde birkaç sefer denedim, hata vermeden çalışıyor.
Yapılan değişiklikler: msWord set olayı for döngüsü dışına alındı,
Şablon dosyası salt okunur açıldı, kaydetmeden kapatıldı,
Pdf kaydet olayında ise "adobe" seçeneği değil de "Pdf veya xps" seçeneği kullanıldı.

Kod:

Sub ZZZZ_Uzlaşma_HazırlaRBozkurt()
Dim Uzlasma As Word.Document

Set R1 = ThisWorkbook.Worksheets("Kaynak1")
Set R2 = ThisWorkbook.Worksheets("ProjeBilgileri")
sonsatir = R1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
yoll = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"

kaydet2 = ThisWorkbook.Path & "\Tutanak\"
kaydet1 = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"

If Len(Dir(kaydet2, vbDirectory)) = 0 Then MkDir kaydet2
If Len(Dir(kaydet1, vbDirectory)) = 0 Then MkDir kaydet1

Set msword = CreateObject("word.application")
msword.Visible = True

For i = 2 To sonsatir
Set Uzlasma = msword.Documents.Open(Filename:=sablon, ReadOnly:=True)
'TAŞINMAZ SATIRLARI
Uzlasma.Bookmarks("İl").Range = R1.Cells(i, "C")                'İL
Uzlasma.Bookmarks("İlçe").Range = R1.Cells(i, "D")              'İLÇE
Uzlasma.Bookmarks("Mahalle").Range = R1.Cells(i, "E")           'MAHALLE
Uzlasma.Bookmarks("Ada").Range = R1.Cells(i, "F")               'ADA
Uzlasma.Bookmarks("Parsel").Range = R1.Cells(i, "G")            'PARSEL
Uzlasma.Bookmarks("YüzÖlçüm").Range = R1.Cells(i, "L")          'YÖZ ÖLÇÜMÜ
'MALİK SATIRLARI
Uzlasma.Bookmarks("KDN").Range = R1.Cells(i, "B")               'KDN
Uzlasma.Bookmarks("TC").Range = R1.Cells(i, "S")                'TC
Uzlasma.Bookmarks("AdıSoyadı").Range = R1.Cells(i, "H")         'ADI SOYADI
Uzlasma.Bookmarks("AdıSoyadı2").Range = R1.Cells(i, "H")        'ADI SOYADI 2
Uzlasma.Bookmarks("BabaAdı").Range = R1.Cells(i, "I")           'BABA ADI
Uzlasma.Bookmarks("Cins").Range = R1.Cells(i, "K")              'CİNS
Uzlasma.Bookmarks("DoğumTarihi").Range = R1.Cells(i, "T")       'DOĞUM TARİHİ
Uzlasma.Bookmarks("Hissesi").Range = R1.Cells(i, "J")           'HİSSE
'BEDEL SATIRLARI
Uzlasma.Bookmarks("İstimlakBedel").Range = Format(R1.Cells(i, "P"), "0.00")      'KAM. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("İrtifakBedel").Range = Format(R1.Cells(i, "Q"), "0.00")       'İRTİFAK. BEDEL (AÇIKLAMA)
Uzlasma.Bookmarks("ToplamBedel").Range = Format(R1.Cells(i, "R"), "0.00")        'TOPLAM BEDEL
'KAMULAŞTIRMA ALANLARI
Uzlasma.Bookmarks("İrtifak").Range = Format(R1.Cells(i, "N"), "0.00")           'İRTİFAK
Uzlasma.Bookmarks("İrtifak2").Range = Format(R1.Cells(i, "N"), "0.00")          'İRTİFAK ALANI (AÇIKLAMA)
Uzlasma.Bookmarks("İstimlak").Range = Format(R1.Cells(i, "M"), "0.00")          'KAM. ALAN
Uzlasma.Bookmarks("İstimlak2").Range = Format(R1.Cells(i, "M"), "0.00")         'KAM. ALAN (AÇIKLAMA)

'Alttaki satırda çağrılacak veriler tüm sayfalar için sabittir.
Uzlasma.Bookmarks("TesisBilgisi").Range = R2.Cells(1, 2) 'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKTarih").Range = R2.Cells(2, 2) 'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("YKKSayı").Range = R2.Cells(3, 2) 'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

'Komisyon Üyeleri
Uzlasma.Bookmarks("Baskan").Range = R2.Cells(5, 2)          'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("BaskanU").Range = R2.Cells(6, 2)         'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1").Range = R2.Cells(7, 2)            'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye1U").Range = R2.Cells(8, 2)           'TÜM DOSYALARA R2 SAYFASI B1 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2").Range = R2.Cells(9, 2)            'TÜM DOSYALARA R2 SAYFASI B2 HÜCRESİ ÇEKİLECEK'
Uzlasma.Bookmarks("Uye2U").Range = R2.Cells(10, 2)          'TÜM DOSYALARA R2 SAYFASI B3 HÜCRESİ ÇEKİLECEK'

DosyaAdi = R1.Cells(i, "B") & " - " & R1.Cells(i, "H") & R1.Cells(i, "J") & " (TC " & R1.Cells(i, "S") & ")" & " (Uzlaşma)"
MyArray = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
For x = LBound(MyArray) To UBound(MyArray)
    DosyaAdi = Replace(DosyaAdi, MyArray(x), "_", 1)
Next x
dosyayol = yoll & DosyaAdi & ".pdf"
'Uzlasma.SaveAs dosyayol

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        dosyayol _
        , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForOnScreen, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
    ShowVisualBasicEditor = True

Uzlasma.Close 0
Next i
msword.Quit
MsgBox "işlem tamam"
End Sub

RBozkurt · 27 Nisan 2022

Geri dönüşler için ayrı ayrı teşekkür ediyorum. Yarın gün içinde ivedilikle deneyip sonucu bildiririm.

RBozkurt · 28 Nisan 2022

Korhan beyin paylaşmış olduğu mesajda Next X den sonraki kısmı alttaki şekilde değiştirdim. Şuan çalışıyor.
Herkese çok teşekkür ederim.

C++:

Next x
dosyayol = yoll & DosyaAdi & ".pdf"
Uzlasma.ExportAsFixedFormat OutputFileName:=dosyayol _
    , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
    Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=False, _
    CreateBookmarks:=wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
    BitmapMissingFonts:=False, UseISO19005_1:=False
Uzlasma.Close
msword.Quit SaveChanges:=wdSaveChanges
Next i
End Sub

RBozkurt · 28 Nisan 2022

Sayın @Korhan Ayhan tekrardan merhaba. Kusura bakmayın tekrar tekrar rahatsız ediyorum.
Yukarıdaki problem çözüldü. PDF olarak kaydedince şablon dosyasını açıyor sürekli verileri ekleyerek kaydediyor.
Doğal olarak şablon dosyasıda bozuluyor. Bunun önüne nasıl geçebilirim. Teşekkürler.

Soru VBA Word Doldurma Hatası Hakkında

Uzman

????

Administrator

????

Administrator

????

Administrator

????

Administrator

????

????

Ekli dosyalar

Uzman

Uzman

Administrator

????

????

????

????