VBA İle Word Dosyası Düzenlerken Salt Okunur Hatası Alma?

karakrall01 · 2 Mart 2023

Herkese kolay gelsin, ben vba ile şablon halinde bulunan word belgelerimde düzenlemeler yaptırıyorum. Ancak şöyle bir sıkıntı ile karşılaştım; formum üzerinde gerekli yerleri doldurduktan sonra word belgelerime aktarmak istediğimde sırası ile farklı word belgelerime aktarma yapıyor ve istediğim yere kayıt yapıyor ancak kayıtlar yapıldıktan sonra bunları salt okunur modunda kayıt ediyor malesef. Ben nerede hata yapıyorum bilemedim, word belgesinin işi bitince kapattırmam gerekiyor herhalde ama onunda kodunu bulamadım malesef. Yardımcı olursanız sevinirim kod bloğumun bir kısmını bırakıyorum aşağıya burda nereye nasıl bir kod yazmam lazım ki word işlemleri bittikten sonra word kapatması lazım ki salt okunur halde kalmasın. saygılar herkese.

Kod:

Private Sub CommandButton1_Click()
Dim doc As Word.Document
Set wordapp = CreateObject("word.application")
sablon = "C:\belgelerim\sablon.docx"



Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("t").Range.InsertAfter Cells(1, 1)
doc.Bookmarks("tarih").Range.InsertAfter Cells(2, 1)
doc.Bookmarks("kim").Range.InsertAfter Cells(3, 1)
doc.Bookmarks("ödemesi").Range.InsertAfter Cells(4, 1)
doc.Bookmarks("sahibi").Range.InsertAfter Cells(5, 1)
doc.Bookmarks("sirket").Range.InsertAfter Cells(6, 1)


doc.SaveAs2 "C:\kayıtlar\güncel.docx"

End sub

tukayf · 2 Mart 2023

kodun el altına

Kod:

.close

ya da

Kod:

docx.close

şeklinde yazıp deneyebilir misiniz.

karakrall01 · 2 Mart 2023

tukayf' Alıntı:
kodun el altına

Kod:

.close

ya da

Kod:

docx.close

şeklinde yazıp deneyebilir misiniz.

hocam .Close ve .Quit yazılsallarını kullandım başarılı bir şekilde sonuç veriyor fakat bu kodları kullandığımda işlem çok uzun sürüyor. Bu kodlar olmadan sade şekilde 2-4 sn içinde oluşturuyor bu kodları eklediğimde 20-30 sn çıkıyor bir işlem diğer türlüde salt okunur gatası veriyor bende ne yapacağımı şaşırdım

RBozkurt · 2 Mart 2023

Merhaba, aşağıdaki konumda @Korhan Ayhan üstadımızın paylaşmış olduğu kod bloğunu uyarlayarak deneyiniz.

Soru - VBA Word Doldurma Hatası Hakkında

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

www.excel.web.tr

karakrall01 · 2 Mart 2023

RBozkurt' Alıntı:
Merhaba, aşağıdaki konumda @Korhan Ayhan üstadımızın paylaşmış olduğu kod bloğunu uyarlayarak deneyiniz.

Soru - VBA Word Doldurma Hatası Hakkında

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

www.excel.web.tr

Hocam baktım ona ama istediğim gibi kırpamadım baya ileri seviye geldi bana

RBozkurt · 2 Mart 2023

karakrall01' Alıntı:
Hocam baktım ona ama istediğim gibi kırpamadım baya ileri seviye geldi bana

Oldu sanırım, deneyiniz. Olmazsa örnek bir dosya ekleyiniz.
C:\belgelerim\sablon.docx bu adresleri kullanmak yerine excel dosyasının bulunduğu klasöre
sablon = ThisWorkbook.Path & "\sablon.docx"
Dosya = ThisWorkbook.Path & "\güncel.docx"
gibi tanımlama yapılması daha kullanışlıdır...

Edit:

Kod:

Private Sub CommandButton1_Click()

Dosya As String
Sablon As String
wordapp As Object

Dim doc As Word.Document

sablon = "C:\belgelerim\sablon.docx"
Dosya = "C:\kayıtlar\güncel.docx"

Set wordapp = GetObject(, "Word.Application")
If Err.Number <> 0 Then Set wordapp = CreateObject("Word.Application")
On Error GoTo 0

Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("t").Range.InsertAfter Cells(1, 1)
doc.Bookmarks("tarih").Range.InsertAfter Cells(2, 1)
doc.Bookmarks("kim").Range.InsertAfter Cells(3, 1)
doc.Bookmarks("ödemesi").Range.InsertAfter Cells(4, 1)
doc.Bookmarks("sahibi").Range.InsertAfter Cells(5, 1)
doc.Bookmarks("sirket").Range.InsertAfter Cells(6, 1)

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

doc.Close False

0
wordapp.Quit
Set wordapp = Nothing

End sub

karakrall01 · 2 Mart 2023

RBozkurt' Alıntı:

Oldu sanırım, deneyiniz. Olmazsa örnek bir dosya ekleyiniz.
C:\belgelerim\sablon.docx bu adresleri kullanmak yerine excel dosyasının bulunduğu klasöre
sablon = ThisWorkbook.Path & "\sablon.docx"
Dosya = ThisWorkbook.Path & "\güncel.docx"
gibi tanımlama yapılması daha kullanışlıdır...

Kod:

Private Sub CommandButton1_Click()

Dosya As String
Dim doc As Word.Document

Set wordapp = CreateObject("word.application")

sablon = "C:\belgelerim\sablon.docx"

On Error Resume Next
Setwordapp = GetObject(, "Word.Application")
If Err.Number <> 0 Then Set wordapp = CreateObject("Word.Application")
On Error GoTo

Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("t").Range.InsertAfter Cells(1, 1)
doc.Bookmarks("tarih").Range.InsertAfter Cells(2, 1)
doc.Bookmarks("kim").Range.InsertAfter Cells(3, 1)
doc.Bookmarks("ödemesi").Range.InsertAfter Cells(4, 1)
doc.Bookmarks("sahibi").Range.InsertAfter Cells(5, 1)
doc.Bookmarks("sirket").Range.InsertAfter Cells(6, 1)


Dosya = "C:\kayıtlar\güncel.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

doc.Close False

wordapp.Quit
Set wordapp = Nothing

End sub

Hocam elinize sağlık yarın ilk fırsatta deniyeceğim ve dönüş yapıcağım

karakrall01 · 3 Mart 2023

RBozkurt' Alıntı:

Oldu sanırım, deneyiniz. Olmazsa örnek bir dosya ekleyiniz.
C:\belgelerim\sablon.docx bu adresleri kullanmak yerine excel dosyasının bulunduğu klasöre
sablon = ThisWorkbook.Path & "\sablon.docx"
Dosya = ThisWorkbook.Path & "\güncel.docx"
gibi tanımlama yapılması daha kullanışlıdır...

Edit:

Kod:

Private Sub CommandButton1_Click()

Dosya As String
Sablon As String
wordapp As Object

Dim doc As Word.Document

sablon = "C:\belgelerim\sablon.docx"
Dosya = "C:\kayıtlar\güncel.docx"

Set wordapp = GetObject(, "Word.Application")
If Err.Number <> 0 Then Set wordapp = CreateObject("Word.Application")
On Error GoTo 0

Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("t").Range.InsertAfter Cells(1, 1)
doc.Bookmarks("tarih").Range.InsertAfter Cells(2, 1)
doc.Bookmarks("kim").Range.InsertAfter Cells(3, 1)
doc.Bookmarks("ödemesi").Range.InsertAfter Cells(4, 1)
doc.Bookmarks("sahibi").Range.InsertAfter Cells(5, 1)
doc.Bookmarks("sirket").Range.InsertAfter Cells(6, 1)

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

doc.Close False

0
wordapp.Quit
Set wordapp = Nothing

End sub

Hocam hata veriyor neden ama bilemedim bi türlü

RBozkurt · 3 Mart 2023

6. Mesajdakini deneyin, dosya ekleyin bakmaya calisayim

karakrall01 · 3 Mart 2023

RBozkurt' Alıntı:
6. Mesajdakini deneyin, dosya ekleyin bakmaya calisayim

hocam ekledim örnek çalışma

RBozkurt · 3 Mart 2023

Eklediğiniz şablonda Bookmarklar yok ?

Verilerin alındığı sayfa hangisidir?

Bookmarkları ekleyip kodu deneyiniz..

Kod:

Sub Aktar()

Dim Dosya As String
Dim Sablon As String
Dim Word_App As Object
Dim doc As Object

Sablon = ThisWorkbook.Path & "\sablon.docx"
Dosya = ThisWorkbook.Path & "\güncel.docx"

    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

Set doc = Word_App.Documents.Open(Sablon)
    With doc
    .Bookmarks("t").Range.InsertAfter Cells(1, 1)
    .Bookmarks("tarih").Range.InsertAfter Cells(2, 1)
    .Bookmarks("kim").Range.InsertAfter Cells(3, 1)
    .Bookmarks("ödemesi").Range.InsertAfter Cells(4, 1)
    .Bookmarks("sahibi").Range.InsertAfter Cells(5, 1)
    .Bookmarks("sirket").Range.InsertAfter Cells(6, 1)

    .SaveAs2 Filename:=Dosya _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

    .Close False
    End With
Word_App.Quit
Set Word_App = Nothing

End Sub


Private Sub CommandButton1_Click()
Call Aktar
End Sub

karakrall01 · 3 Mart 2023

RBozkurt' Alıntı:

Eklediğiniz şablonda Bookmarklar yok ?

Ekli dosyayı görüntüle 243344

Verilerin alındığı sayfa hangisidir?

Bookmarkları ekleyip kodu deneyiniz..

Kod:

Sub Aktar()

Dim Dosya As String
Dim Sablon As String
Dim Word_App As Object
Dim doc As Object

Sablon = ThisWorkbook.Path & "\sablon.docx"
Dosya = ThisWorkbook.Path & "\güncel.docx"

    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

Set doc = Word_App.Documents.Open(Sablon)
    With doc
    .Bookmarks("t").Range.InsertAfter Cells(1, 1)
    .Bookmarks("tarih").Range.InsertAfter Cells(2, 1)
    .Bookmarks("kim").Range.InsertAfter Cells(3, 1)
    .Bookmarks("ödemesi").Range.InsertAfter Cells(4, 1)
    .Bookmarks("sahibi").Range.InsertAfter Cells(5, 1)
    .Bookmarks("sirket").Range.InsertAfter Cells(6, 1)

    .SaveAs2 Filename:=Dosya _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

    .Close False
    End With
Word_App.Quit
Set Word_App = Nothing

End Sub


Private Sub CommandButton1_Click()
Call Aktar
End Sub

Hocam Bookmarks için veri aldığım sayfa DATA sayfası ancak aşağıda gösterdiğim gibi belirtmeme rağmen Bookmarks hata veriyor gene

Kod:

 .Bookmarks("t").Range.InsertAfter Worksheets("DATA").Cells(8, 1)
 .Bookmarks("tarih").Range.InsertAfter Worksheets("DATA").Cells(9, 1)
 .Bookmarks("kim”).Range.InsertAfter Worksheets("DATA").Cells(10,1)
 .Bookmarks("ödemesi").Range.InsertAfter Worksheets("DATA").Cells(11,1)

RBozkurt · 3 Mart 2023

Şablon dosyasında mesela "t" bookmarkını tanımladınız mı?

karakrall01 · 3 Mart 2023

RBozkurt' Alıntı:
Şablon dosyasında mesela "t" bookmarkını tanımladınız mı?

Doğrudur hocam wordde yer işareti kısmından belirttim yerini

RBozkurt · 3 Mart 2023

karakrall01' Alıntı:
Doğrudur hocam wordde yer işareti kısmından belirttim yerini

Deneyiniz

Kod:

Sub Aktar()

Dim Dosya As String
Dim Sablon As String
Dim Word_App As Object
Dim doc As Object
Dim S1 As Worksheet

Set S1 = Sheets("DATA")
Sablon = ThisWorkbook.Path & "\sablon.docx"
Dosya = ThisWorkbook.Path & "\güncel.docx"

    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

Set doc = Word_App.Documents.Open(Sablon)
    With doc
    .Bookmarks("t").Range = S1.Cells(8, 1)
    .Bookmarks("tarih").Range = S1.Cells(9, 1)
    .Bookmarks("kim").Range = S1.Cells(10, 1)
    .Bookmarks("ödemesi").Range = S1.Cells(11, 1)
'    .Bookmarks("sahibi").Range = S1.Cells(12, 1)
'    .Bookmarks("sirket").Range = S1.Cells(13, 1)

    .SaveAs2 Filename:=Dosya _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

    .Close False
    End With
Word_App.Quit
Set Word_App = Nothing

End Sub


Private Sub CommandButton1_Click()
Call Aktar
End Sub

karakrall01 · 3 Mart 2023

H

RBozkurt' Alıntı:

Deneyiniz

Kod:

Sub Aktar()

Dim Dosya As String
Dim Sablon As String
Dim Word_App As Object
Dim doc As Object
Dim S1 As Worksheet

Set S1 = Sheets("DATA")
Sablon = ThisWorkbook.Path & "\sablon.docx"
Dosya = ThisWorkbook.Path & "\güncel.docx"

    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

Set doc = Word_App.Documents.Open(Sablon)
    With doc
    .Bookmarks("t").Range = S1.Cells(8, 1)
    .Bookmarks("tarih").Range = S1.Cells(9, 1)
    .Bookmarks("kim").Range = S1.Cells(10, 1)
    .Bookmarks("ödemesi").Range = S1.Cells(11, 1)
'    .Bookmarks("sahibi").Range = S1.Cells(12, 1)
'    .Bookmarks("sirket").Range = S1.Cells(13, 1)

    .SaveAs2 Filename:=Dosya _
    , FileFormat:=wdFormatXMLDocument, LockComments:=False, Password:="", _
    AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
    EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
    :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15

    .Close False
    End With
Word_App.Quit
Set Word_App = Nothing

End Sub


Private Sub CommandButton1_Click()
Call Aktar
End Sub

Hocam teşekkürler sağolunn çözüldü ama hızında pek değişme olmadı salt okumur konusunu çözdü şükür

RBozkurt · 3 Mart 2023

Kolay gelsin.

Ben bu makro ile yüzlerce tutanak hazırlıyorum, daha hızlısını görmedim.

VBA İle Word Dosyası Düzenlerken Salt Okunur Hatası Alma?

karakrall01

tukayf

karakrall01

RBozkurt

𐱅𐰇𐰼𐰚

Soru - VBA Word Doldurma Hatası Hakkında

karakrall01

Soru - VBA Word Doldurma Hatası Hakkında

RBozkurt

𐱅𐰇𐰼𐰚

karakrall01

karakrall01

RBozkurt

𐱅𐰇𐰼𐰚

karakrall01

Ekli dosyalar

RBozkurt

𐱅𐰇𐰼𐰚

karakrall01

RBozkurt

𐱅𐰇𐰼𐰚

karakrall01

RBozkurt

𐱅𐰇𐰼𐰚

karakrall01

RBozkurt

𐱅𐰇𐰼𐰚