Excelden Word Belgesi açma kodu

[officer08]

Herkese iyi günler.

Excelde sayfa1 de bir tablom var ve 1 tane comandbutonum var. Amacım comandbutona yazdığım ve aşağıda örneğini veridiğim kod grubu ile daha önceden kaydettiğim word belgesini açmak.

Sorunum ise; açmak için kullandığım kodda dosya yolunda word belgesinin ismi olarak Sayfa1 deki Tablonun D2 hücresi olarak aç diyebilmek. Zaten bu isimle bu word belgesi önceden kayıtlı var ama nasıl uzantının sonuna ekleyip açacağımı bilemiyorum.

Sub WordOnizle()
Dim WordDoc As Object

Set WordDoc = CreateObject("Word.Application")
WordDoc.Visible = True
WordDoc.Documents.Open ("C:\belgelerim\bu kısma D2'de yazan veri adıyla kayıtlı word belgesi demem lazım")

WordDoc.Documents("bu kısma D2'de yazan veri adıyla kayıtlı word belgesi demem lazım").PrintPreview

Set WordDoc = Nothing
End Sub

Teşekkürler

 

[Ömer]

Merhaba,

Deneyiniz.

Sub WordOnizle()

    Dim WordDoc As Object, yol As String

    Set WordDoc = CreateObject("Word.Application")
    yol = "C:\Belgelerim\" & [D2] & ".docx"
    
    WordDoc.Visible = True
    
    WordDoc.Documents.Open (yol)
    WordDoc.Documents(yol).PrintPreview
    
    Set WordDoc = Nothing
        
End Sub

 

[officer08]

Ömer Bey teşekkür ederim sizin kodlar çalıştı ancak şöyle bir sorun oluştu açılırken salt okunur açıyor, farklı kaydet diyor bunun sebebi ise sanırım word belgesini exceldeki hücrelere göre doldurup kaydettiğim ilk kodlardan kaynaklanıyor. Kayıt işlemi esnasında görev yöneticisinde belge açık kalıyor. Kod içerisinde bir yerlerde kapama yapmam gerekli sanırım kod örneğini aşağıya yapıştırsam yardımcı olursanız sevinirim.

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

For i = 2 To 2

Set doc = wordapp.Documents.Open(sablon)

doc.Bookmarks("dosya").Range.InsertAfter Cells(i, 1)
doc.Bookmarks("kalem").Range.InsertAfter Cells(i, 2)
doc.Bookmarks("defter").Range.InsertAfter Cells(i, 3)
doc.Bookmarks("kitap").Range.InsertAfter Cells(i, 4)
doc.Bookmarks("cetvel").Range.InsertAfter Cells(i, 5)
doc.Bookmarks("saat").Range.InsertAfter Cells(i, 6)
doc.Bookmarks("tarihi").Range.InsertAfter Cells(i, 8)
doc.Bookmarks("boya").Range.InsertAfter Cells(i, 19)
doc.Bookmarks("liste").Range.InsertAfter Cells(i, 9)
doc.Bookmarks("soyadi").Range.InsertAfter Cells(i, 10)

doc.SaveAs2 "C:\belgelerim\" & Cells(i, 4).Text

Next i

End Sub