Exceldeki veriyi Worde yazdırma

A

Aldırma_Reis

Katılım
8 Aralık 2010
Mesajlar
14
Excel Vers. ve Dili
Excel 2003 Türkçe
Arkadaşalar elimdeki excel tablosundaki verileri, bir word belgesinde belirlediğim yerlere atmasını istiyorum. Exceldeki her satır için de wordde yeni bir sayfaya yazdırması gerekiyor. Pek açıklayıcı olmadı galiba ama ekteki örnekle durum anlaşılacaktır. Yardımlarınız için şimdiden teşekkürler..
 

Ekli dosyalar

E

EErkut

Katılım
12 Mayıs 2006
Mesajlar
125
Excel Vers. ve Dili
Microsoft 365 Tr
Altın Üyelik Bitiş Tarihi
28-04-2024
basit bir örnek hazırlamaya çalıştım.
Adı alanına yani a sütununa çift tıklayarak ilgili ismi worde gönderebilirsiniz.
 

Ekli dosyalar

leumruk

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,471
Excel Vers. ve Dili
Office 2010 & 2013 tr
Merhaba,
Ekteki örneği inceleyin.
Kod: 
Sub Worde_Aktar()
Set WD = CreateObject("Word.Application")
WD.Visible = True
Set MyDoc = WD.Documents.Add(DocumentType:=0)
    With WD.ActiveDocument.Styles(-1).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With WD.ActiveDocument.PageSetup
        .TopMargin = WD.CentimetersToPoints(2.5)
        .BottomMargin = WD.CentimetersToPoints(2.5)
        .LeftMargin = WD.CentimetersToPoints(2.5)
        .RightMargin = WD.CentimetersToPoints(2.5)
        .Gutter = WD.CentimetersToPoints(0)
        .HeaderDistance = WD.CentimetersToPoints(1.25)
        .FooterDistance = WD.CentimetersToPoints(1.25)
        .PageWidth = WD.CentimetersToPoints(29.7)
        .PageHeight = WD.CentimetersToPoints(21)
        .VerticalAlignment = 0
    End With
For x = 1 To [a65536].End(3).Row
veri = Cells(x, 1) & " " & Cells(x, 2) & Chr(10) & Chr(10) & Chr(10) & Cells(x, 3) & "/" _
& Cells(x, 4) & Chr(10) & Chr(10) & Cells(x, 7) & Chr(10) & Chr(10) & Cells(x, 5) _
& "                                  " & Cells(x, 6)
WD.Selection = veri
With WD.Selection
    .ParagraphFormat.Alignment = 1
    .Font.Name = "Times New Roman"
    .Font.Size = 30
    .EndKey Unit:=6
    If x < [a65536].End(3).Row Then
    .InsertBreak Type:=7
    End If
End With
Next
MsgBox "Aktarım tamamlanmıştır.", vbInformation, "Kodlayan: l e u m r u k"
End Sub
 

Ekli dosyalar

A

Aldırma_Reis

Katılım
8 Aralık 2010
Mesajlar
14
Excel Vers. ve Dili
Excel 2003 Türkçe
leumruk' Alıntı:
Merhaba,
Ekteki örneği inceleyin.
Kod: 
Sub Worde_Aktar()
Set WD = CreateObject("Word.Application")
WD.Visible = True
Set MyDoc = WD.Documents.Add(DocumentType:=0)
    With WD.ActiveDocument.Styles(-1).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With WD.ActiveDocument.PageSetup
        .TopMargin = WD.CentimetersToPoints(2.5)
        .BottomMargin = WD.CentimetersToPoints(2.5)
        .LeftMargin = WD.CentimetersToPoints(2.5)
        .RightMargin = WD.CentimetersToPoints(2.5)
        .Gutter = WD.CentimetersToPoints(0)
        .HeaderDistance = WD.CentimetersToPoints(1.25)
        .FooterDistance = WD.CentimetersToPoints(1.25)
        .PageWidth = WD.CentimetersToPoints(29.7)
        .PageHeight = WD.CentimetersToPoints(21)
        .VerticalAlignment = 0
    End With
For x = 1 To [a65536].End(3).Row
veri = Cells(x, 1) & " " & Cells(x, 2) & Chr(10) & Chr(10) & Chr(10) & Cells(x, 3) & "/" _
& Cells(x, 4) & Chr(10) & Chr(10) & Cells(x, 7) & Chr(10) & Chr(10) & Cells(x, 5) _
& "                                  " & Cells(x, 6)
WD.Selection = veri
With WD.Selection
    .ParagraphFormat.Alignment = 1
    .Font.Name = "Times New Roman"
    .Font.Size = 30
    .EndKey Unit:=6
    If x < [a65536].End(3).Row Then
    .InsertBreak Type:=7
    End If
End With
Next
MsgBox "Aktarım tamamlanmıştır.", vbInformation, "Kodlayan: l e u m r u k"
End Sub
Genişletmek için tıkla ...
Eyvallah sağoalsın. Yanlız worddeki yazıların konumunu, fontunu, yazı stilini nası değiştirebilirim bi de excele yeni sütünlar ekleyerek onları wordde belirleyeceğim yerlere nasıl yazdırabilirim?
 
A

Aldırma_Reis

Katılım
8 Aralık 2010
Mesajlar
14
Excel Vers. ve Dili
Excel 2003 Türkçe
Eyvallah sağoalsın. Yanlız worddeki yazıların konumunu, fontunu, yazı stilini nası değiştirebilirim bi de excele yeni sütünlar ekleyerek onları wordde belirleyeceğim yerlere nasıl yazdırabilirim?
 
leumruk

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,471
Excel Vers. ve Dili
Office 2010 & 2013 tr
Merhaba,
Mavi ile belirttiğim kısım sayfa ayarları. Buradan oranları değiştirebilirsiniz.
Kırmızı ile belirttiğim kısım Yazı tipi, boyutu ve paragraf ayarı. Örneğin yazı boyutu 30, siz bunu değiştirdiğinizde sizin yazdığınız orana göre aktaracaktır. Times New Roman yerine de başka yazı tipi yazabilirsiniz.

Gelelim önemli olan kısma. Yeşil kısım aktaracağınız verinin derlendiği kısımdır. Yazıyla ne kadar anlatılır bilemiyorum; ama deneyeyim:
Cells(x, 1) Bu kısımda x excel dosyasındaki satırı ifade eder. 1 ise sütun numarası "&" bu ve anlamındadır ve verileri birleştirmeye yarar.
Örneğin aşağıdaki kısım: Döngü 1'de iken 1. satırın 1. sütunu, bir boşluk, 1. satırın 2. sütunu, 3 paragraf boşluğu, 1. satırın 3. sütunu... şeklinde excel dosyanızdaki verileri birleştirmeye yarar. Ve bunu veri adında bir değişkene atar. Sonrasını kodlar yapıyor. Bu kısmı isteğinize göre doğru ayarlamanız gerekli.
Kod: 
veri = Cells(X, 1) & " " & Cells(X, 2) & Chr(10) & Chr(10) & Chr(10) & Cells(X, 3) & "/" _
& Cells(X, 4) & Chr(10) & Chr(10) & Cells(X, 7) & Chr(10) & Chr(10) & Cells(X, 5) _
& "                                  " & Cells(X, 6)
Kod: 
Sub Worde_Aktar()
Set WD = CreateObject("Word.Application")
WD.Visible = True
Set MyDoc = WD.Documents.Add(DocumentType:=0)
    With WD.ActiveDocument.Styles(-1).Font
        If .NameFarEast = .NameAscii Then
            .NameAscii = ""
        End If
        .NameFarEast = ""
    End With
    With WD.ActiveDocument.PageSetup
       [COLOR="Navy"] .TopMargin = WD.CentimetersToPoints(2.5)
        .BottomMargin = WD.CentimetersToPoints(2.5)
        .LeftMargin = WD.CentimetersToPoints(2.5)
        .RightMargin = WD.CentimetersToPoints(2.5)
        .Gutter = WD.CentimetersToPoints(0)
        .HeaderDistance = WD.CentimetersToPoints(1.25)
        .FooterDistance = WD.CentimetersToPoints(1.25)
        .PageWidth = WD.CentimetersToPoints(29.7)
        .PageHeight = WD.CentimetersToPoints(21)
        .VerticalAlignment = 0[/COLOR]
    End With
For x = 1 To [a65536].End(3).Row
[COLOR="DarkGreen"]veri = Cells(x, 1) & " " & Cells(x, 2) & Chr(10) & Chr(10) & Chr(10) & Cells(x, 3) & "/" _
& Cells(x, 4) & Chr(10) & Chr(10) & Cells(x, 7) & Chr(10) & Chr(10) & Cells(x, 5) _
& "                                  " & Cells(x, 6)[/COLOR]
WD.Selection = veri
With WD.Selection
 [COLOR="DarkRed"]   .ParagraphFormat.Alignment = 1
    .Font.Name = "Times New Roman"
    .Font.Size = 30[/COLOR]
    .EndKey Unit:=6
    If x < [a65536].End(3).Row Then
    .InsertBreak Type:=7
    End If
End With
Next
MsgBox "Aktarım tamamlanmıştır.", vbInformation, "Kodlayan: l e u m r u k"
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst