Soru VBA Word Doldurma Hatası Hakkında

Korhan Ayhan · 28 Nisan 2022

Paylaşmış olduğum kodu revize ettim. Tekrar deneyiniz.

RBozkurt · 28 Nisan 2022

Merhaba, Alttaki hatayı almaktayım.

RBozkurt · 28 Nisan 2022

Set Uzlasma = msword.Documents.Open(Filename:=sablon, ReadOnly:=False)

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

Korhan Ayhan · 28 Nisan 2022

Benim paylaşımımda zaten sizin düzelttim dediğiniz şekilde yazıyor.

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

RBozkurt · 28 Nisan 2022

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

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 · 28 Nisan 2022

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 · 28 Nisan 2022

@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 · 28 Nisan 2022

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ı.

Korhan Ayhan · 28 Nisan 2022

Sonuçlarda doğruysa mesele yoktur. Güle güle kullanın..

RBozkurt · 6 Eylül 2022

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 · 6 Eylül 2022

Merhaba,
50. mesajdaki durum hakkında yardımcı olabilir misiniz?

Kodlar 46. mesajdadır.

Korhan Ayhan · 7 Eylül 2022

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 · 7 Eylül 2022

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

Sayın @Korhan Ayhan üstadım. Emeğinize sağlık. Verileri çoğaltıp denedim sonuç resimdeki gibi.
Teşekkür ederim.

ruhadam26 · 3 Ocak 2023

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

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 · 3 Ocak 2023

Ş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

ruhadam26 · 3 Ocak 2023

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

Allah sizden razı olsun elinize emeğinize sağlık teşekkürler

VecİK · 24 Temmuz 2024

Merhaba, elimde 100 satırlık excel var bunu worde aktarmak istiyorum. Buradan yola çıkarak bir yere kadar geldim. Şu an sorunum tek satır olarak attı. İşime yaracak olan exceldeki 100 satırı 100 sayfa seklınde worde aktarmak. Yaptığım işlem ;+
NOT: Bunu yapmak istemem bir ayakkabı firmasında calısıyorum bilgiler excelden gelıyor. Etiket çıkarmak için worde tasarım yaptım. Tek sefer tüm içeriği aktarık barkod yazıcıdan cıkarmak ıstıyorum.
Private Sub CommandButton1_Click()
Dim doc As Word.Document
Set wordapp = CreateObject("word.application")
sablon = "C:\Users\ismail\Desktop\Test\sablon.docx"

For i = 2 To 110
Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("KALITE").Range.InsertAfter Cells(i, 1)
doc.Bookmarks("MODEL").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("RENK").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("KIRK").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("KIRKBIR").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("KIRKIKI").Range.InsertAfter Cells(i, 6)
doc.Bookmarks("KIRKUC").Range.InsertAfter Cells(i, 7)
doc.Bookmarks("KIRKDORT").Range.InsertAfter Cells(i, 8)
doc.Bookmarks("KIRKBES").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("Toplam").Range.InsertAfter Cells(i, 10)
doc.Bookmarks("MKOD").Range.InsertAfter Cells(i, 11)
doc.SaveAs2 "C:\Users\ismail\Desktop\Test\test.docx"

Next i

End Sub

Korhan Ayhan · 24 Temmuz 2024

Örnek dosyalarınızı paylaşabilirmisiniz.

VecİK · 24 Temmuz 2024

Merhaba dosyayı wetransfer üzerinden kaydettim https://we.tl/t-BO02hbd0I0

Soru VBA Word Doldurma Hatası Hakkında

Korhan Ayhan

Administrator

RBozkurt

????

RBozkurt

????

Korhan Ayhan

Administrator

RBozkurt

????

Korhan Ayhan

Administrator

RBozkurt

????

RBozkurt

????

Korhan Ayhan

Administrator

RBozkurt

????

RBozkurt

????

Korhan Ayhan

Administrator

RBozkurt

????

ruhadam26

Korhan Ayhan

Administrator

ruhadam26

VecİK

Korhan Ayhan

Administrator

VecİK