Excel'den Word'e istenilen veriyi aktarma

[policeman]

Excel'deki verilerimi yine excel'de ayrı sayfada İNDİS formülü ile raporlama yapmaktaydım ama yaptığım raporlamayı kullanmakta olduğumuz Workcube sayfasına aktarma yapamıyordum..Workcube'ye aktarmak ancak Word'den kopyala yapıştır ile oluyor..
Veriler çok olduğu zamanda Adres Mektup Birleştir yöntemini kullanıyordum.. Ama tek tek gerektiğinde ve bu devamlı olduğundan zorlanıyordum..
Sayın Leumruk'un örneklerinde bu işin makro ile olabildiğini görünce kendime uyarlamak istedim ama makro bilgim olmadığı için başaramadım.
Örneğim ektedir,başta sayın leumruk olmak üzere ilgili hocalarımdan yardım bekliyorum..
Saygılarımla...

 

[leumruk]

Merhaba,
İsteğinizi gerçekleştirmek için şablon dosyasına gerek yok. Kod yardımıyla word belgesi açtırıp veriler içine kopyalanabilir. Tabi yapmak istediğiniz, eklediğiniz dosyayla aynı ise... İsteğe göre kodlara sayfa ayarı da eklenebilir. Örneği inceleyin ona göre hareket edelim.
A sütununda hangi hücreye çift tıklarsanız, o satır worde aktarılıp ad verilip kaydedilecektir.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("a2:a" & [a65536].End(3).Row)) Is Nothing Then
If Target <> "" Then
Cancel = True
Application.ScreenUpdating = False
Set wd = CreateObject("Word.Application")
Set wddoc = wd.Documents.Add(DocumentType:=0)
wd.Visible = True
For x = 1 To 9
metin = metin & Chr(10) & Cells(1, x) & ": " & Cells(Target.Row, x)
Next
    With wd.Selection.PageSetup
        .PageWidth = wd.CentimetersToPoints(21)
        .PageHeight = wd.CentimetersToPoints(14.8)
    End With
wd.Selection = metin
yol_ds = ThisWorkbook.Path & "\" & Target & "-" & Cells(Target.Row, 3) & ".doc"
wddoc.SaveAs yol_ds
wddoc.Application.Quit
MsgBox "Aktarım tamamlanmıştır.", vbInformation, "Kodlayan: l e u m r u k"
End If
End If

If Not Intersect(Target, Range("e1")) Is Nothing Then
Cancel = True
For y = 2 To [d65536].End(3).Row
Cells(y, 5) = WorksheetFunction.CountIf(Range("d2:d" & y), Cells(y, 4))
Next
End If

End Sub

 

[policeman]

Sn. Leumruk çok teşekkürler tam istediğim gibi,sadece sayfa ayarından yarım sayfa olarakta ayarlayabilirsek 1.isteğim tamamdır..
2.isteğim mümkün değilse o sütunu iptal edebilirim ama mümkün olursa çok iyi olacak..
Saygılarımla...

 

[policeman]

www.excel.web.tr sayfalarından bulduğum bir macroyu kendime göre uyarladım;

Sub eşitlik_61()
Dim ts
For ts = 2 To Cells(Rows.Count, "D").End(xlUp).Row
Cells(ts, "C") = WorksheetFunction.CountIf(Range("D"), Cells(ts, "D"))
Next
End Sub

Hangi TC toplamda kaç kere yazılmış veriyor ama benim istediğim her TC'nin yanına kaçıncı olduğunu yazdırmak..

 

[leumruk]

Merhaba,
Bir önceki mesajımı ve örnek dosyayı güncelledim.
Adet sütununda çift tıkladığınız hücreye o satırdaki tc'nin kaçıncı olduğu yazacaktır.
Word sayfa ayar kodunu da istediğiniz şekilde kodların içine yerleştirdim.

 

[policeman]

Sn. Leumruk hata verdi;debug
wd.WordBasic.PageSetupPaper PageWidth:="21", PageHeight:="14.8"
Ne yapmam lazım?

 

[policeman]

Sn. Leumruk "Adet sütununda çift tıkladığınız hücreye o satırdaki tc'nin kaçıncı olduğu yazacaktır." evet yazıyor ama bunu Adet yazısına çift tıkladığımızda tüm verileri denetliyecek şekilde değiştirmek mümkün mü?..
Dokuzbine yaklaşan verim mevcut bunları tabloya yapıştırınca teker teker çift tık zor gibi gözüküyor,makro E1 hücresine atansa olur mu?
Saygılarımla..

 

[leumruk]

Sn. Leumruk hata verdi;debug
wd.WordBasic.PageSetupPaper PageWidth:="21", PageHeight:="14.8"
Ne yapmam lazım?

Sayfa ayarı kodunu 2007'den elde etmiştim. Sanırım versiyon uyuşmazlığı oldu. Her iki versiyonda da çalışabilecek bir kodlama ekledim.

Diğer isteğinize göre de kodlarda düzenleme yaptım.

Güncel kodlama ve ek dosya ilk mesajımda...

 

[policeman]

Sn. Leumruk tam istediğim gibi oldu;Allah razı olsun,hakkınızı helal edin..
Saygılarımla...

 

[leumruk]

Sn. Leumruk tam istediğim gibi oldu;Allah razı olsun,hakkınızı helal edin..
Saygılarımla...

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

 

[leumruk]

Sürekli aynı satırları aktardığını farkettim. Deneme dosyamı sizin dosyanıza uyarlarken bu kısmını gözden kaçırmışım.
Kodu düzenledim. Dosyayı yeniden indirip kullanın.