Word'a Excel Sayfasini Aktama

[duranproject]

Merhabalar dosyada günlük 1 ve günlük 2 sayfalarım var. userform üzerinde 2 tane buton yaptım. Günlüklerimi word sayfasına aktarmak istiyorum. Böylece günlüklerimi depolamış olurum. userform üzerinde günlük 1'i word'a aktar butonu ile günlük2yi worda aktar butonu var. şimdi ikisinden birine tıkladığım zaman ilgili günlüğün excel sayfasına yapışsın, istiyorum. Bana yardım ederseniz sevinirim.

 

[duranproject]

bu işin çözümü yok mu? Lütfen yardım ediniz?

 

[hsayar]

USERFORMA

Private Sub CommandButton1_Click()
Worksheets("GÜNLÜK1").Range("A3:j81").Copy
Call SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, False)
Unload Me
End Sub

Private Sub CommandButton2_Click()
Worksheets("GÜNLÜK2").Range("A3:G68").Copy
Call SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, False)
Unload Me
End Sub

MODULE

Sub SeciliAlaniWordeYapistir(ust, alt, sol, sag As Integer, yon As Boolean)
'A4 sayfası
Application.ScreenUpdating = True
    'Range("A1:L5" & SnDlSt + 7).Copy
    Set objword = CreateObject("Word.Application")
    Set Mydoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
    objword.Visible = True
    
    With Mydoc.PageSetup
        .TopMargin = ust '42.55
        .BottomMargin = alt    '42.55
        .LeftMargin = sol     '25#
        .RightMargin = sag    '25#
        If yon = True Then
            .PageWidth = 595.35 'CentimetersToPoints(21)     'dikey
            .PageHeight = 841.95 'CentimetersToPoints(29,7)  'dikey
        Else
            .PageWidth = 841.95 'CentimetersToPoints(29.7)   'yataysayfa
            .PageHeight = 595.35 'CentimetersToPoints(21)    'yataysayfa
        End If
    End With
    objword.Selection.PasteSpecial Link:=False, DataType:=10
    Application.CutCopyMode = False
Set objword = Nothing:      Set Mydoc = Nothing
Application.ScreenUpdating = False
End Sub

 

[duranproject]

TeŞekkÜrler.....

 

[hsayar]

Rica ederim.
bu arada sayfa adı "Günlük 2" değil "Günlük2" olacak.

 

[duranproject]

Sayın hsayar, kodları da yapıştırdım. Ama bu sefer de word sayfasında düzensiz duruyor. BUnu da halledebilir miyiz?

 

[hsayar]

halledemeyiz çünkü dikey sayfada gözükmüyor yatay sayfada bol geliyor... onu siz exceldeki sayfanın sütun genişlkikleirni ayarlayarak yapabilirsiniz

 

[duranproject]

yine de çok teşekkür ederim

 

[hsayar]

Şöyle Deneyin
MODULE

Sub SeciliAlaniWordeYapistir(ust, alt, sol, sag As Integer, yon, kapat As Boolean, kytAd)
'Excel.web.tr/Hsayar
'(ust: Üst Kenar Boşluğu, alt: Kenar Boşluğu, sol: Kenar Boşluğu, sag: Üst Kenar Boşluğu
'yon: Dikey ise True, Yatay ise False
'kapat: Kapatılacak ise True, Kapatılmayacak ise False
'kytAd: Dosyanın kaydedileceği ad
Application.ScreenUpdating = True
    Dim objword As Object
    Set objword = CreateObject("Word.Application")
    Set Mydoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
    objword.Visible = True
    
    With Mydoc.PageSetup
        .TopMargin = ust '42.55
        .BottomMargin = alt    '42.55
        .LeftMargin = sol     '25#
        .RightMargin = sag    '25#
        If yon = True Then
            .PageWidth = 595.35 'CentimetersToPoints(21)     'dikey
            .PageHeight = 841.95 'CentimetersToPoints(29,7)  'dikey
        Else
            .PageWidth = 841.95 'CentimetersToPoints(29.7)   'yataysayfa
            .PageHeight = 595.35 'CentimetersToPoints(21)    'yataysayfa
        End If
    End With
    objword.Selection.PasteSpecial Link:=False, DataType:=10
    Application.CutCopyMode = False
    
    If kytAd <> "" Then
       With objword
            .ActiveDocument.SaveAs kytAd
            If kapat = True Then
                .ActiveDocument.Close
                .Quit
            End If
        End With
    End If
Set objword = Nothing:      Set Mydoc = Nothing
Application.ScreenUpdating = False
End Sub

USERFORMA

Private Sub CommandButton1_Click()
ThisWorkbook.Worksheets("GÜNLÜK1").Activate
ThisWorkbook.Worksheets("GÜNLÜK1").Range("A3:j81").Copy
strAd = ThisWorkbook.Path & "\" & ActiveSheet.Name & "-" & Format(Now, "dd-mm-yy h-mm-ss") & ".doc"
Call SeciliAlaniWordeYapistir(42.55, 42.55, [B][color="red"]25, 25[/color][/B],False, True, strAd)

Unload Me
End Sub

Private Sub CommandButton2_Click()
ThisWorkbook.Worksheets("GÜNLÜK2").Activate
ThisWorkbook.Worksheets("GÜNLÜK2").Range("A3:g68").Copy
strAd = ThisWorkbook.Path & "\" & ActiveSheet.Name & "-" & Format(Now, "dd-mm-yy h-mm-ss") & ".doc"
Call SeciliAlaniWordeYapistir(42.55, 42.55, [B][color="red"]25, 25[/color][/B], False, True, strAd)
Unload Me
End Sub

yapıştırın daha sonra
25, 25
alanlarını artırark deneyin tabloyu ortalarsınız

 

[hsayar]

Günlük2 için aşağıdaki gibi fena olmadı ama sütun genişlikerini biraz kısarsanız dikey sayfayada oturur ozaman 1. falseyi de true yapmanız gerekir

Private Sub CommandButton2_Click()
ThisWorkbook.Worksheets("GÜNLÜK2").Activate
ThisWorkbook.Worksheets("GÜNLÜK2").Range("b3:g68").Copy
strAd = ""
strAd = ThisWorkbook.Path & "\" & ActiveSheet.Name & "-" & Format(Now, "dd-mm-yy h-mm-ss") & ".doc"
Call SeciliAlaniWordeYapistir(42.55, 42.55, 115, 115, False, True, strAd)
Unload Me
End Sub

 

[duranproject]

denedim compile error:expected end sub yazıyor ve hata veriyor

 

[hsayar]

Call SeciliAlaniWordeYapistir(42.55, 42.55, 115, 115, False, True, strAd)
bu hale getirtiniz ve hata aldınız bende doğru çalışıyordu virgüllere dikkat edin

bu arada eski kodların tümünü silin ve 9. mesajdaki kodları yapıştırın.
CommandButton2_Click() olayınıda 10.mesajdaki gibi değiştirin.

 

[duranproject]

evet şimdi oldu. Ama excellde önizlemede benim günlük1 iki sayfada gözüküyor ve günlük 2de ise tek sayfada gözüküyor. Sorun worde yapıştırınca bu önizlemedeki gibi kalmıyor.

 

[hsayar]

Call SeciliAlaniWordeYapistir(42.55, 42.55, 115, 115, False, True, strAd)

42.55 değerlerini küçültün alt ve üst kenar boşluklarını ifade eder bunlar

 

[duranproject]

Çok TeŞekkÜr Ettİm. Bİrİncİ GÜnlÜĞÜ Ayarladim, İkİncİ GÜnlÜĞÜ False TRUE Yaptim Yanİ Dİkey Yaptim. Bİrİncİsİ Tamam İkİncİ GÜnlÜk Ne Yaptimsa Olmadi. Hsayar Yardimlariniz İÇİn TeŞekkÜr Ettİm

 

[hsayar]

ikinci günlüğün sütun genişliklerini hafif kısın cdef uygun gibi gelmişti bana

 

[duranproject]

hsayar hocam ilginize teşekkür ederim. yanlarını biraz kıstım. ama iki sayfada çıkıyor. oysa sayfa excellde tek sayfa gözüküyor. İşte problem burada başlıyor

 

[hsayar]

hsayar hocam ilginize teşekkür ederim. yanlarını biraz kıstım. ama iki sayfada çıkıyor. oysa sayfa excellde tek sayfa gözüküyor. İşte problem burada başlıyor

az önce baktımda günlük2 sayfası %85 olarak orantılanmış. ve kağıt boyutunu %100 yapınca dört sayfada çıkıyor.
excelden worde kopyalamyı %100 boyutlu yapıyor...
orantılayarak tablo olark aktarmanın yolu varsa bende sevinirim.

şimdilik excelde sayfayı %100 olarak boyutlandırın ve 1 sayfaya sığacak hale getirin. ve Call Secilialanıwordeyapıştırda kenar boşluklarını vererek makroyu tekrar çağırın.

bu arada ben hoca olacak kadar excelde iyi değilim iyi bir taklitçiyim benimde bilmediğim çok şey var.
Kodun kullanımı

Call SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, False, True, strAd)

42.55 üst kenar boşluğu (nokta cinsinden değeri> 1,5cm)
42.55 alt kenar boşluğu (nokta cinsinden değeri> 1,5cm)
25 sol kenar boşluğu (nokta cinsinden değeri> 0,88cm)
25 sağ kenar boşluğu (nokta cinsinden değeri> 0,88cm)
False dikey word sayfası için True, Yatay İçin False
True Kaydedilecekse True, Kaydedilmyecekse False
strAd Kaydedilecekse Ad girilir.