Çözüldü Word birleştirmek

[k0081]

zaten jpg dosyalarını ekliyor birde bmp dosyalarını da ekliyor

If LCase(fL.GetExtensionName(Dosya)) = "jpg" Or LCase(fL.GetExtensionName(Dosya)) = "bmp" Then

Halit hocam ben, #8 nolu koddan bahsetmiştim... o kadda bu vermiş olduğunuz depğişikliği yaptığım zaman, karışık karakter filan ekliyor sayfalara. Resim eklemiyor.

 

[halit3]

Halit hocam ben, #8 nolu koddan bahsetmiştim... o kadda bu vermiş olduğunuz depğişikliği yaptığım zaman, karışık karakter filan ekliyor sayfalara. Resim eklemiyor.

ben 18 nolu mesaja kod ekledim siz 19 nolu mesajda sorunuzu sormuşsunuz cevabım 18 nolu mesajımdaki kod ile ilgiliydi
8 nolu mesajdaki kod ile 18 nolu mesajdaki kodlar çok farklı işlevler yapmaktadır.

 

[k0081]

ben 18 nolu mesaja kod ekledim siz 19 nolu mesajda sorunuzu sormuşsunuz cevabım 18 nolu mesajımdaki kod ile ilgiliydi
8 nolu mesajdaki kod ile 18 nolu mesajdaki kodlar çok farklı işlevler yapmaktadır.

Evet doğrudur. Benim demek istediğim word dosyaları ile ilgili yapmış olduğunuz çalışmanın jpg şekliydi... lazım olan o. Yani daha doğrusu Excel üzerinden çalışma ile ilgili olacaktı. Zaten konu çözüldü. Extradan yazıyoruz hocam. Sıkıntı yok.


Teşekkürler verdiğiniz cevaplar için.

 

[leumruk]

Selamlar,
Kodları hem excelde hem de wordde çalıştırmak için yeniden düzenledim. anadosya adını kendi Word dosyanızın adıyla değiştirin. Excel dosyasının Word dosyasıyla aynı klasörde olduğu varsayılmıştır. İhtiyacınıza göre kendiniz düzenlersiniz.
Kodları bu şekliyle hata almadan hem Word belgesinde hem de excel dosyasında çalıştırabilirsiniz.
WORDDEN VERİ ALMAK İÇİN:

Sub Makro1()
If InStr(1, Application.Name, "Excel", vbTextCompare) > 0 Then
Set wd = CreateObject("word.Application")
wd.Visible = True
yol = ThisWorkbook.Path
dosya = yol & "\anadosya.docm"
wd.Documents.Open dosya
Else
Set wd = Application
End If

yol = wd.ActiveDocument.Path
wd.ChangeFileOpenDirectory yol & "\"
dosya = Dir(yol & "\*doc*")
Do While dosya <> ""
If dosya <> wd.ActiveDocument.Name Then
wd.Selection.EndKey Unit:=6
wd.Selection.InsertNewPage
wd.Selection.InsertFile Filename:=dosya
End If
dosya = Dir
Loop
MsgBox "İşlem tamamlanmıştır.", vbOKOnly, "l e u m r u k"
End Sub

RESİMLERİ WORDE EKLEMEK İÇİN:

Sub Makro2()
If InStr(1, Application.Name, "Excel") > 0 Then
Set wd = CreateObject("word.Application")
wd.Visible = True
yol = ThisWorkbook.Path
dosya = yol & "\anadosya.docm"
wd.Documents.Open dosya
Else
Set wd = Application
End If

yol = wd.ActiveDocument.Path
wd.ChangeFileOpenDirectory yol & "\"
dosya = Dir(yol & "\*jpg")
Do While dosya <> ""
wd.Selection.EndKey Unit:=6
wd.Selection.InsertNewPage
wd.Selection.InlineShapes.AddPicture Filename:=dosya
dosya = Dir
Loop
MsgBox "İşlem tamamlanmıştır.", vbOKOnly, "l e u m r u k"
End Sub

 

[k0081]

leumruk

Hocam çok teşekkür ederim, Test ettim çalışıyor. Tamamdır... elinize sağılık.

 

[leumruk]

leumruk

Hocam çok teşekkür ederim, Test ettim çalışıyor. Tamamdır... elinize sağılık.

Rica ederim. İyi çalışmalar...