Worde aktarma makrosu.

[leumruk]

Sub worde()
Range("D1: E100").Copy
Set objword = CreateObject("Word.Application")
objword.Visible = True
Set MyDoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
objword.Selection.PasteSpecial DataType:=2
End Sub

Selamlar, Yukarıda yazılı makro, exceldeki belgeyi word dosyasına aktarıyor.
Bu makroyu excelin içerisindeki word nesnesine uyarlayabilir miyiz? Yukardaki makronun yazılı olduğu eki gönderiyorum.

 

[hamitcan]

Çift tıklama olmasa da tek tıklama ile bu kodu çalıştırmanız mümkün.Yaptığınız şeklin üzerine gelip farenin sağ tuşuna basın, sonra da makro ata seçeneği yardımıyla kodu şekle bağlayın.

 

[leumruk]

Çift tıklama olmasa da tek tıklama ile bu kodu çalıştırmanız mümkün.Yaptığınız şeklin üzerine gelip farenin sağ tuşuna basın, sonra da makro ata seçeneği yardımıyla kodu şekle bağlayın.

Yanlış anlaşıldım sanırım. Ben word nesnesinin simgesine makro bağlamak istemiyorum; Yazdığım makronun kodlarında değişiklik yaparak, Exceldeki tabloyu, ayrı bir word belgesi açıp aktarması yerine, excelin içinde oluşturduğum bu word nesnesinin içine atmasını istiyorum.

 

[hamitcan]

İstediğinizi şimdi anladım. Fakat, amacınızın ne olduğunu kavrayamadım. Eğer üzerinde bir değişiklik yapmayacaksanız, ilgili alanı, şeklin içine resim olarak gömebilirsiniz.

 

[leumruk]

Tabloyu aktardıktan sonra, üzerinde düzenleme yapacağım. Word nesnesine uyarlamadaki amacım ise word dosyasında sabit bir biçim uygulayacağım. Şu haliyle açılan her word dosyası standart biçimle açılıyor. Bense Wordde sütunlar oluşturup, sayfa kenarlıklarını ayarlayıp bunları sabitleyeceğim. Bu da ancak tabloyu excelin kendi parçası olan word nesnesine aktardığımda olabiliyor.

 

[yunus127]

Çok teşekkürler.

 

[leumruk]

Çok teşekkürler.

Henüz cevap gelmedi, niye teşekkür ettiğinizi anlayamadım. Sanırım farkında olmadan bir sorunuza cevap verdik.

 

[hamitcan]

Zannedersem Sayın Ali'nin bu tip bir çalışması vardı. Ben notlarım arasında bulduğum kodu yayınlıyorum. Detaylı bilgi için sitede arama yapın.

Sub ExceldenWordeaktar()
' Microsoft Word Object Library kitaplığını aktif hale getirin
Dim WDApp As Word.Application
Dim WDDoc As Word.Document
' Excelde bir aralık seçin
If Not TypeName(Selection) = "Range" Then
    MsgBox "Lütfen excel sayfasından aralığınızı seçiniz", vbExclamation, _
        "Hiçbir aralık seçilmedi"
Else
    ' Word belgeside açık olmalıdır
    Set WDApp = GetObject(, "Word.Application")
    ' Referans aktif doküman alınacak
    Set WDDoc = WDApp.ActiveDocument
 
 
    ' Aralık kopyalanacak
    Selection.Copy
    ' Aralık yapıştırılacak
    WDApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteRTF, _
        Placement:=wdInLine, DisplayAsIcon:=False
    ' Temizlenecek
    Set WDDoc = Nothing
    Set WDApp = Nothing
End If
End Sub

 

[leumruk]

Sub ExceldenWordeaktar()
Sheets("Sayfa1").Range("D2:E64").Select
Sheets("Sayfa1").OLEObjects("A Grubu").Verb (xlVerbPrimary)
Set WDApp = GetObject(, "Word.Application")
Set WDDoc = WDApp.ActiveDocument
Selection.Copy
WDApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteRTF, _
Placement:=wdInLine, DisplayAsIcon:=False
Set WDDoc = Nothing
Set WDApp = Nothing
End Sub

Syn. Hamitcan'ın gönderdiği kodlarda şöyle bir değişiklik yaptım ve mutlu son. İlgilenen arkadaşlar olabilir düşüncesiyle dosyayı ekliyorum.
Bu arada Syn. Hamitcan,
Gönderdiğiniz kodlardan ve ilginizden ötürü çok teşekkür ederim. :bravo: