Soru VBA Word Doldurma Hatası Hakkında

RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,250
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
MAKRO KAYDET yöntemini kullanarak bu kodları kolaylıkla elde edebilirsiniz.
 
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,250
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,250
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,250
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu kodu deneyebileceğimiz örnek dosyalar varsa paylaşırmısınız.
 
N

necati

Katılım
20 Şubat 2007
Mesajlar
658
Excel Vers. ve Dili
2007 Excel, Word Tr
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

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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
Genişletmek için tıkla ...
Merhaba
Resimdeki hatayı almaktayım

236197
 
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026

Ekli dosyalar

halit3

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,799
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,799
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,250
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
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

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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.
 
N

necati

Katılım
20 Şubat 2007
Mesajlar
658
Excel Vers. ve Dili
2007 Excel, Word Tr
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

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Geri dönüşler için ayrı ayrı teşekkür ediyorum. Yarın gün içinde ivedilikle deneyip sonucu bildiririm.
 
RBozkurt

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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

RBozkurt

𐱅𐰇𐰼𐰚
Altın Üye
Katılım
10 Ocak 2018
Mesajlar
686
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
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.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst