Soru VBA Word Doldurma Hatası Hakkında

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Paylaşmış olduğum kodu revize ettim. Tekrar deneyiniz.
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Merhaba, Alttaki hatayı almaktayım.

236224
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Set Uzlasma = msword.Documents.Open(Filename:=sablon, ReadOnly:=False)

şeklinde değiştirdim düzeldi gibi. bir kaç sayfa test edeyim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Benim paylaşımımda zaten sizin düzelttim dediğiniz şekilde yazıyor.

Sanırım kodları karıştırdınız...
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Korhan Ayhan' Alıntı:
Benim paylaşımımda zaten sizin düzelttim dediğiniz şekilde yazıyor.

Sanırım kodları karıştırdınız...
Genişletmek için tıkla ...
Sayın @Korhan Ayhan bey. Elinize sağlık hakkınızı helal edin.
Hata benden kaynaklı kopyalarken diğer mesajdaki kodu almışım. Şuan şablon bozmadan çalışıyor.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu da biraz daha hızlı sonuç veriyor...

C++: 
Option Explicit

Sub Uzlasma_Hazirla()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet
    Dim Klasor As String, Sablon As String, Word_App As Object
    Dim Uzlasma As Object, Dosya As String, Veri As Variant
    Dim Gecersiz_Karakter As Variant, Son As Long, X As Long, Y As Byte
    
    Zaman = Timer
    
    Set S1 = Sheets("Kaynak1")
    Set S2 = Sheets("ProjeBilgileri")
    
    Klasor = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"
    Sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"
    
    On Error Resume Next
    Shell ("cmd /c md " & Chr(34) & Klasor & Chr(34))
    On Error GoTo 0
    
    Son = S1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Veri = S1.Range("A2:V" & Son).Value
    
    On Error Resume Next
    Set Word_App = GetObject(, "Word.Application")
    If Err.Number <> 0 Then Set Word_App = CreateObject("Word.Application")
    On Error GoTo 0
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Set Uzlasma = Word_App.Documents.Open(Sablon)
        With Uzlasma
            .Bookmarks("İl").Range = Veri(X, 3)
            .Bookmarks("İlçe").Range = Veri(X, 4)
            .Bookmarks("Mahalle").Range = Veri(X, 5)
            .Bookmarks("Ada").Range = Veri(X, 6)
            .Bookmarks("Parsel").Range = Veri(X, 7)
            .Bookmarks("YüzÖlçüm").Range = Veri(X, 12)
            .Bookmarks("KDN").Range = Veri(X, 2)
            .Bookmarks("TC").Range = Veri(X, 19)
            .Bookmarks("AdıSoyadı").Range = Veri(X, 8)
            .Bookmarks("AdıSoyadı2").Range = Veri(X, 8)
            .Bookmarks("BabaAdı").Range = Veri(X, 9)
            .Bookmarks("Cins").Range = Veri(X, 11)
            .Bookmarks("DoğumTarihi").Range = Veri(X, 20)
            .Bookmarks("Hissesi").Range = Veri(X, 10)
            .Bookmarks("İstimlakBedel").Range = Format(Veri(X, 16), "0.00")
            .Bookmarks("İrtifakBedel").Range = Format(Veri(X, 17), "0.00")
            .Bookmarks("ToplamBedel").Range = Format(Veri(X, 18), "0.00")
            .Bookmarks("İrtifak").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İrtifak2").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İstimlak").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("İstimlak2").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("TesisBilgisi").Range = S2.Cells(1, 2)
            .Bookmarks("YKKTarih").Range = S2.Cells(2, 2)
            .Bookmarks("YKKSayı").Range = S2.Cells(3, 2)
            .Bookmarks("Baskan").Range = S2.Cells(5, 2)
            .Bookmarks("BaskanU").Range = S2.Cells(6, 2)
            .Bookmarks("Uye1").Range = S2.Cells(7, 2)
            .Bookmarks("Uye1U").Range = S2.Cells(8, 2)
            .Bookmarks("Uye2").Range = S2.Cells(9, 2)
            .Bookmarks("Uye2U").Range = S2.Cells(10, 2)
            
            Dosya = Veri(X, 2) & " - " & Veri(X, 8) & Veri(X, 10) & " (TC " & Veri(X, 19) & ")" & " (Uzlaşma)"
            Gecersiz_Karakter = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
                
            For Y = LBound(Gecersiz_Karakter) To UBound(Gecersiz_Karakter)
                Dosya = Replace(Dosya, Gecersiz_Karakter(Y), "_", 1)
            Next
            
            Dosya = Klasor & Dosya & ".pdf"
            
            .ExportAsFixedFormat OutputFileName:=Dosya, _
            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
            
            .Close False
        End With
    Next
    
    Word_App.Quit
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Word_App = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
@Korhan Ayhan bey elinize sağlık çok güzel olmuş bu şekilde de..
2 kattan fazla hızlanma olduğunu düşünüyorum. Projelerde deneyip kıyaslamasını geri dönüş olarak bırakırım. Çok teşekkür ederim.
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Sayın @Korhan Ayhan bey yeni kodlarınızı test ettim.
Normalde 3'dakika 48'saniye süren işlem 26saniyede tamamlandı. Resmen uçak moduna geçti proje. 10 kattan daha fazla hızlanma var.
Bu kadar hızlanacağını hiç düşünmemiştim elinize sağlık.


Daha önce hazırladığım 618 sayfa tutanaktan oluşan proje;
Normalde 1 saate yakın tamamlanmıştı.
Şuan 7 dakikada tamamlandı.
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sonuçlarda doğruysa mesele yoktur. Güle güle kullanın..
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Merhaba,
Konu üzerinden biraz zaman geçti. Yeni fark ettiğim bir durum vardı yardımcı olabilir misiniz?

Kodlarda herhangi bir problem yoktur. Bazen oluşturulan evrakların mükerrer olması gerekiyor.
Yani birbiri kopyası 3 satır veri olunca sadece 1 adet dosya oluşturuyor. Daha doğrusu 3 adet oluşuyor, üzerine yazdığı için tek adet dosya oluşmuş oluyor.
Yukarıdaki kod dizinine bu düzeltme yapılabilir mi?
Aynı isimde dosya olunca sonuna (2), (3) gibi veya herhangi bir değer getirilebilir mi?
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Merhaba,
50. mesajdaki durum hakkında yardımcı olabilir misiniz?

Kodlar 46. mesajdadır.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++: 
Option Explicit

Sub Uzlasma_Hazirla()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Klasor As String, Sablon As String, Word_App As Object, FSO As Object
    Dim Uzlasma As Object, Dosya As String, Veri As Variant
    Dim Gecersiz_Karakter As Variant, Son As Long, X As Long, Y As Byte
    
    Zaman = Timer
    
    Set S1 = Sheets("Kaynak1")
    Set S2 = Sheets("ProjeBilgileri")
    Set Dizi = VBA.CreateObject("Scripting.Dictionary")
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
    
    Klasor = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"
    Sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"
    
    On Error Resume Next
    Shell ("cmd /c md " & Chr(34) & Klasor & Chr(34))
    On Error GoTo 0
    
    Son = S1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    Veri = S1.Range("A2:V" & Son).Value
    
    On Error Resume Next
    Set Word_App = GetObject(, "Word.Application")
    If Err.Number <> 0 Then Set Word_App = CreateObject("Word.Application")
    On Error GoTo 0
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Set Uzlasma = Word_App.Documents.Open(Sablon)
        With Uzlasma
            .Bookmarks("İl").Range = Veri(X, 3)
            .Bookmarks("İlçe").Range = Veri(X, 4)
            .Bookmarks("Mahalle").Range = Veri(X, 5)
            .Bookmarks("Ada").Range = Veri(X, 6)
            .Bookmarks("Parsel").Range = Veri(X, 7)
            .Bookmarks("YüzÖlçüm").Range = Veri(X, 12)
            .Bookmarks("KDN").Range = Veri(X, 2)
            .Bookmarks("TC").Range = Veri(X, 19)
            .Bookmarks("AdıSoyadı").Range = Veri(X, 8)
            .Bookmarks("AdıSoyadı2").Range = Veri(X, 8)
            .Bookmarks("BabaAdı").Range = Veri(X, 9)
            .Bookmarks("Cins").Range = Veri(X, 11)
            .Bookmarks("DoğumTarihi").Range = Veri(X, 20)
            .Bookmarks("Hissesi").Range = Veri(X, 10)
            .Bookmarks("İstimlakBedel").Range = Format(Veri(X, 16), "0.00")
            .Bookmarks("İrtifakBedel").Range = Format(Veri(X, 17), "0.00")
            .Bookmarks("ToplamBedel").Range = Format(Veri(X, 18), "0.00")
            .Bookmarks("İrtifak").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İrtifak2").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İstimlak").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("İstimlak2").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("TesisBilgisi").Range = S2.Cells(1, 2)
            .Bookmarks("YKKTarih").Range = S2.Cells(2, 2)
            .Bookmarks("YKKSayı").Range = S2.Cells(3, 2)
            .Bookmarks("Baskan").Range = S2.Cells(5, 2)
            .Bookmarks("BaskanU").Range = S2.Cells(6, 2)
            .Bookmarks("Uye1").Range = S2.Cells(7, 2)
            .Bookmarks("Uye1U").Range = S2.Cells(8, 2)
            .Bookmarks("Uye2").Range = S2.Cells(9, 2)
            .Bookmarks("Uye2U").Range = S2.Cells(10, 2)
            
            Dosya = Veri(X, 2) & " - " & Veri(X, 8) & Veri(X, 10) & " (TC " & Veri(X, 19) & ")" & " (Uzlaşma)"
            Gecersiz_Karakter = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
                
            For Y = LBound(Gecersiz_Karakter) To UBound(Gecersiz_Karakter)
                Dosya = Replace(Dosya, Gecersiz_Karakter(Y), "_", 1)
            Next
            
            Dosya = Klasor & Dosya & ".pdf"
            
            If Not Dizi.Exists(Dosya) Then
                Dizi.Add Dosya, 0
            Else
10              Dizi.Item(Dosya) = Dizi.Item(Dosya) + 1
                Dosya = Klasor & FSO.GetBaseName(Dosya) & "_" & _
                Dizi.Item(Dosya) & "." & FSO.GetExtensionName(Dosya)
            End If
            
            If Dir(Dosya) <> "" Then GoTo 10
            
            .ExportAsFixedFormat OutputFileName:=Dosya, _
            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
            
            .Close False
        End With
    Next
    
    Word_App.Quit
    Dizi.RemoveAll
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set Word_App = Nothing
    Set Dizi = Nothing
    Set FSO = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
RBozkurt

RBozkurt

Altın Üye
Katılım
10 Ocak 2018
Mesajlar
583
Excel Vers. ve Dili
Microsoft Office 2024
Google Sheets
Altın Üyelik Bitiş Tarihi
19-12-2026
Korhan Ayhan' Alıntı:
Deneyiniz.

C++: 
Option Explicit

Sub Uzlasma_Hazirla()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet, Dizi As Object
    Dim Klasor As String, Sablon As String, Word_App As Object, FSO As Object
    Dim Uzlasma As Object, Dosya As String, Veri As Variant
    Dim Gecersiz_Karakter As Variant, Son As Long, X As Long, Y As Byte
   
    Zaman = Timer
   
    Set S1 = Sheets("Kaynak1")
    Set S2 = Sheets("ProjeBilgileri")
    Set Dizi = VBA.CreateObject("Scripting.Dictionary")
    Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
   
    Klasor = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"
    Sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"
   
    On Error Resume Next
    Shell ("cmd /c md " & Chr(34) & Klasor & Chr(34))
    On Error GoTo 0
   
    Son = S1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    Veri = S1.Range("A2:V" & Son).Value
   
    On Error Resume Next
    Set Word_App = GetObject(, "Word.Application")
    If Err.Number <> 0 Then Set Word_App = CreateObject("Word.Application")
    On Error GoTo 0
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Set Uzlasma = Word_App.Documents.Open(Sablon)
        With Uzlasma
            .Bookmarks("İl").Range = Veri(X, 3)
            .Bookmarks("İlçe").Range = Veri(X, 4)
            .Bookmarks("Mahalle").Range = Veri(X, 5)
            .Bookmarks("Ada").Range = Veri(X, 6)
            .Bookmarks("Parsel").Range = Veri(X, 7)
            .Bookmarks("YüzÖlçüm").Range = Veri(X, 12)
            .Bookmarks("KDN").Range = Veri(X, 2)
            .Bookmarks("TC").Range = Veri(X, 19)
            .Bookmarks("AdıSoyadı").Range = Veri(X, 8)
            .Bookmarks("AdıSoyadı2").Range = Veri(X, 8)
            .Bookmarks("BabaAdı").Range = Veri(X, 9)
            .Bookmarks("Cins").Range = Veri(X, 11)
            .Bookmarks("DoğumTarihi").Range = Veri(X, 20)
            .Bookmarks("Hissesi").Range = Veri(X, 10)
            .Bookmarks("İstimlakBedel").Range = Format(Veri(X, 16), "0.00")
            .Bookmarks("İrtifakBedel").Range = Format(Veri(X, 17), "0.00")
            .Bookmarks("ToplamBedel").Range = Format(Veri(X, 18), "0.00")
            .Bookmarks("İrtifak").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İrtifak2").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İstimlak").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("İstimlak2").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("TesisBilgisi").Range = S2.Cells(1, 2)
            .Bookmarks("YKKTarih").Range = S2.Cells(2, 2)
            .Bookmarks("YKKSayı").Range = S2.Cells(3, 2)
            .Bookmarks("Baskan").Range = S2.Cells(5, 2)
            .Bookmarks("BaskanU").Range = S2.Cells(6, 2)
            .Bookmarks("Uye1").Range = S2.Cells(7, 2)
            .Bookmarks("Uye1U").Range = S2.Cells(8, 2)
            .Bookmarks("Uye2").Range = S2.Cells(9, 2)
            .Bookmarks("Uye2U").Range = S2.Cells(10, 2)
           
            Dosya = Veri(X, 2) & " - " & Veri(X, 8) & Veri(X, 10) & " (TC " & Veri(X, 19) & ")" & " (Uzlaşma)"
            Gecersiz_Karakter = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
               
            For Y = LBound(Gecersiz_Karakter) To UBound(Gecersiz_Karakter)
                Dosya = Replace(Dosya, Gecersiz_Karakter(Y), "_", 1)
            Next
           
            Dosya = Klasor & Dosya & ".pdf"
           
            If Not Dizi.Exists(Dosya) Then
                Dizi.Add Dosya, 0
            Else
10              Dizi.Item(Dosya) = Dizi.Item(Dosya) + 1
                Dosya = Klasor & FSO.GetBaseName(Dosya) & "_" & _
                Dizi.Item(Dosya) & "." & FSO.GetExtensionName(Dosya)
            End If
           
            If Dir(Dosya) <> "" Then GoTo 10
           
            .ExportAsFixedFormat OutputFileName:=Dosya, _
            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
           
            .Close False
        End With
    Next
   
    Word_App.Quit
    Dizi.RemoveAll
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set Word_App = Nothing
    Set Dizi = Nothing
    Set FSO = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Genişletmek için tıkla ...
Sayın @Korhan Ayhan üstadım. Emeğinize sağlık. Verileri çoğaltıp denedim sonuç resimdeki gibi.
Teşekkür ederim.

238940
 
R

ruhadam26

Altın Üye
Katılım
4 Aralık 2017
Mesajlar
116
Excel Vers. ve Dili
2010-2016 türkçe
Altın Üyelik Bitiş Tarihi
20-12-2025
Korhan Ayhan' Alıntı:
Bu da biraz daha hızlı sonuç veriyor...

C++: 
Option Explicit

Sub Uzlasma_Hazirla()
    Dim Zaman As Double, S1 As Worksheet, S2 As Worksheet
    Dim Klasor As String, Sablon As String, Word_App As Object
    Dim Uzlasma As Object, Dosya As String, Veri As Variant
    Dim Gecersiz_Karakter As Variant, Son As Long, X As Long, Y As Byte
   
    Zaman = Timer
   
    Set S1 = Sheets("Kaynak1")
    Set S2 = Sheets("ProjeBilgileri")
   
    Klasor = ThisWorkbook.Path & "\Tutanak\Uzlaşma Tutanakları\"
    Sablon = ThisWorkbook.Path & "\Şablon\UZLAŞMA.docx"
   
    On Error Resume Next
    Shell ("cmd /c md " & Chr(34) & Klasor & Chr(34))
    On Error GoTo 0
   
    Son = S1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
   
    Veri = S1.Range("A2:V" & Son).Value
   
    On Error Resume Next
    Set Word_App = GetObject(, "Word.Application")
    If Err.Number <> 0 Then Set Word_App = CreateObject("Word.Application")
    On Error GoTo 0
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Set Uzlasma = Word_App.Documents.Open(Sablon)
        With Uzlasma
            .Bookmarks("İl").Range = Veri(X, 3)
            .Bookmarks("İlçe").Range = Veri(X, 4)
            .Bookmarks("Mahalle").Range = Veri(X, 5)
            .Bookmarks("Ada").Range = Veri(X, 6)
            .Bookmarks("Parsel").Range = Veri(X, 7)
            .Bookmarks("YüzÖlçüm").Range = Veri(X, 12)
            .Bookmarks("KDN").Range = Veri(X, 2)
            .Bookmarks("TC").Range = Veri(X, 19)
            .Bookmarks("AdıSoyadı").Range = Veri(X, 8)
            .Bookmarks("AdıSoyadı2").Range = Veri(X, 8)
            .Bookmarks("BabaAdı").Range = Veri(X, 9)
            .Bookmarks("Cins").Range = Veri(X, 11)
            .Bookmarks("DoğumTarihi").Range = Veri(X, 20)
            .Bookmarks("Hissesi").Range = Veri(X, 10)
            .Bookmarks("İstimlakBedel").Range = Format(Veri(X, 16), "0.00")
            .Bookmarks("İrtifakBedel").Range = Format(Veri(X, 17), "0.00")
            .Bookmarks("ToplamBedel").Range = Format(Veri(X, 18), "0.00")
            .Bookmarks("İrtifak").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İrtifak2").Range = Format(Veri(X, 14), "0.00")
            .Bookmarks("İstimlak").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("İstimlak2").Range = Format(Veri(X, 13), "0.00")
            .Bookmarks("TesisBilgisi").Range = S2.Cells(1, 2)
            .Bookmarks("YKKTarih").Range = S2.Cells(2, 2)
            .Bookmarks("YKKSayı").Range = S2.Cells(3, 2)
            .Bookmarks("Baskan").Range = S2.Cells(5, 2)
            .Bookmarks("BaskanU").Range = S2.Cells(6, 2)
            .Bookmarks("Uye1").Range = S2.Cells(7, 2)
            .Bookmarks("Uye1U").Range = S2.Cells(8, 2)
            .Bookmarks("Uye2").Range = S2.Cells(9, 2)
            .Bookmarks("Uye2U").Range = S2.Cells(10, 2)
           
            Dosya = Veri(X, 2) & " - " & Veri(X, 8) & Veri(X, 10) & " (TC " & Veri(X, 19) & ")" & " (Uzlaşma)"
            Gecersiz_Karakter = Array("<", ">", "|", "/", " / ", "*", ":", "\", " \ ", ".", "?", """")
               
            For Y = LBound(Gecersiz_Karakter) To UBound(Gecersiz_Karakter)
                Dosya = Replace(Dosya, Gecersiz_Karakter(Y), "_", 1)
            Next
           
            Dosya = Klasor & Dosya & ".pdf"
           
            .ExportAsFixedFormat OutputFileName:=Dosya, _
            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
           
            .Close False
        End With
    Next
   
    Word_App.Quit
   
    Set S1 = Nothing
    Set S2 = Nothing
    Set Word_App = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
Genişletmek için tıkla ...
Merhaba hocam bunu pdf olarak değilde word olarak keydedilmesini istiyorsak nasil bir yol izlemeliyiz. .pdf yazan yeri .docx olarak değiştiridğimde word dosyları oluşuyor ama hatalı word oluşuyor açılmıyor.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,519
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Şu satırları silip;

C++: 
            Dosya = Klasor & Dosya & ".pdf"
           
            .ExportAsFixedFormat OutputFileName:=Dosya, _
            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
Yerine aşağıdaki satıları ekleyip deneyiniz.

C++: 
            Dosya = Klasor & Dosya & ".docx"
            
            ActiveDocument.SaveAs2 FileName:=Dosya _
            , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
            AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
 
R

ruhadam26

Altın Üye
Katılım
4 Aralık 2017
Mesajlar
116
Excel Vers. ve Dili
2010-2016 türkçe
Altın Üyelik Bitiş Tarihi
20-12-2025
Korhan Ayhan' Alıntı:
Şu satırları silip;

C++: 
            Dosya = Klasor & Dosya & ".pdf"
          
            .ExportAsFixedFormat OutputFileName:=Dosya, _
            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
Yerine aşağıdaki satıları ekleyip deneyiniz.

C++: 
            Dosya = Klasor & Dosya & ".docx"
           
            ActiveDocument.SaveAs2 FileName:=Dosya _
            , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
            AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
            EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
            :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
Genişletmek için tıkla ...
Allah sizden razı olsun elinize emeğinize sağlık teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst