data type(excelden word'e)

[gelen gecer mdmx]

iyi günler exelden worde aktarım yapan kodda bir sorun yaşıyorum:

Private Sub CommandButton1_Click()
fName = Application.InputBox("Dosya ismi girin...", "Dosya")
If fName <> 0 Then
f = InputBox("Kaçıncı Satıra Kadar Aktarsın?", "Aktarılacak Bölge")
Range("A1: ı" & f).Copy
Set objword = CreateObject("Word.Application")
objword.Visible = True
Set MyDoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
objword.Selection.PasteExcelTable False, False, False
objword.activedocument.SaveAs "C:\" & fName & ".doc"
End If
Application.CutCopyMode = False
End Sub

ile kopyalayınca sadece iki sütun alıyor.

Private Sub CommandButton2_Click()
fName = Application.InputBox("Dosya ismi girin...", "Dosya")
If fName <> 0 Then
f = InputBox("Kaçıncı Satıra Kadar Aktarsın?", "Aktarılacak Bölge")
Range("A1: ı" & f).COPY
Set objword = CreateObject("Word.Application")
objword.Visible = True
Set MyDoc = objword.Documents.Add(DocumentType:=wdNewBlankDocument)
objword.Selection.PasteSpecial Link:=False, [COLOR="Red"]DataType:=3[/COLOR]
objword.activedocument.SaveAs "C:\" & fName & ".doc"
End If
Application.CutCopyMode = False
End Sub

ile yapınca sadece bir sayfa aktarıyor. bunu data type=2 istediğim çözüm değil çünkü tabloları aktarmıyor. ne yapmam gerekir sizce?

bu kodları kullanmamın amacını da söyliyeyim belki başka fikirlerde gelebilir. Excel dosyamdaki formülleri linkleri 3. kişiler görmesin istiyorum. bu yüzden excel sayfamı programı isteyenlere word olarak atmak aklıma geldi. şöyle bir macro da olabilir: komut düğmesine tıklayınca excel çalışma sayfamı değiştirelemez bir excel olarak farklı kaydetsin.

 

[hsayar]

Sub SeciliAlaniWordeYapistir(ByVal ust, alt, sol, sag As Integer, _
                          Optional Yatay As Boolean, Optional kapat As Boolean, _
                          Optional DosyaAdı As String = "")
'=================================================================================================='II
'IIIIIIIIII   Excelde Seçili hücrelerdeki bilgileri word belgesine yapıştırır. .        'IIIIIIIIII'II
'=================================================================================================='II
'ust, alt, sol, sag                                Kenar Boşlukları
'Yatay             False (Varsayılan) veya True    Sayfa Yönü
'Kapat             False (Varsayılan) veya True    Kapatılacakmı?
'DosyaAdı          Kapatılırken kayıt edilecekse metin
Dim objWord, MyDoc          As Object
Selection.Copy
Application.ScreenUpdating = True
    Set objWord = CreateObject("Word.Application")
    Set MyDoc = objWord.Documents.Add(DocumentType:=0) 'wdNewBlankDocument
    objWord.Visible = True
 
    With MyDoc.PageSetup
        .TopMargin = ust '42.55
        .BottomMargin = alt    '42.55
        .LeftMargin = sol     '25#
        .RightMargin = sag    '25#
        If Yatay = False 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 DosyaAd&#305; <> "" Then
       With objWord
            .ActiveDocument.SaveAs DosyaAd&#305;
            If kapat = True Then
                .ActiveDocument.Close
                .Quit
            End If
        End With
    End If
Set objWord = Nothing:      Set MyDoc = Nothing
Application.ScreenUpdating = False
End Sub

kendi yaptığım eklentimde ben data type=10 kullanıyoreum eklentiye aşağıdaki linkten ualaşabilirsin:

az sonra
geldim
http://cid-5f022568730f18e0.skydrive.live.com/self.aspx/AddIns2/Hsr%7C_Ozel%7C_Menu%7C0Fonk.xla

 

[hsayar]

Addıns kalasörüne rar içeriğini attıktan sonra eklentiyi modül sayfasına referencelerden (HSR olarak gözükür)eklediğin zaman (genelde kendi kendine ekleniyor)

Sub Worde_Yapistir22()
Range("A1:d7").Select: Selection.Copy
Call SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, , , "c:\excelden.doc")
End Sub

olarak kullanabilirsiniz.

prosodürün adının Worde_Yapistir olarak kullanamazsanız o yüzden değiştirdim.

 

[gelen gecer mdmx]

teşekkür ederim ama dediklerinizi yapamadım bir örnek dosya ile gösterirmisiniz?

 

[hsayar]

1) Karşıdan yükleyi seçin

2) C:\Users\kullanıcıadınız\AppData\Roaming\Microsoft\AddIns
klasörüne dosyayı taşıyın,

3) of2007 için: Excel Seçenekleri, eklentiler tabı, yönet combosundan excel eklenmtilerini seçin ve

gözattan hsr_ozel&menu_fonk.xla dosyasını seçin...

4) yazlı prosodürlerinde çağrılması için referencestend işaretlemek gerektiğinden vba modülünde (alt+f11)

http://img156.imageshack.us/img156/9695/adm4en6.jpg

aynı dosyayı işaretleyin (genlede kendiliğinden işaretlenir)

 

[gelen gecer mdmx]

resimler için çok sağolun bu eklentiyi ekledim ama çalıştıramıyorum. örnek bir excel dosyasında yapabilirmisiniz?

 

[hsayar]

Sub Worde_Yapistir22()
Dim dosyaadı As String
Range("A1:d5").Select
dosyaadı = "c:\excelde14n.doc"
Selection.Copy: Call SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, , , dosyaadı)
End Sub

kodlarınn yer aldığı aşağıdaki dosyada test edebilirsiniz

 

[gelen gecer mdmx]

prosodürün adının Worde_Yapistir olarak kullanamazsanız o yüzden değiştirdim.

demişsiniz ama çözemedim sorunu

Private Sub CommandButton1_Click()
Range("A1:d7").Select: Selection.Copy
Call SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, , , "c:\excelden.doc")
End Sub

diye hata veriyor

 

[gelen gecer mdmx]

SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, , , "c:\excelden.doc")
kısmını tanımıyor

 

[hsayar]

hsr_ozel&menu_fonk.xla
AddIns Klasöründe mevcut mu?
eklentilerde işaretli mi?
VBA sayfasındaki tolls menüsünün references düğmesi ile gelen iletişim kutusunda HSR referencesi işaretli mi?

7. mesajdaki dosyayı denediniz mi?

eğer hepsi evet ve netice alamadı iseneniz bilmiyorum

 

[gelen gecer mdmx]

şimdi oldu çok teşekkür ederim ama sorunum devam etti bu iş olmayacak
sorun ise Range("A1:B500").Select ne olursa olsun iki satır alıyor hücrelerimin bazıları birleşik olduğu için.neyse zamanınızı ayırdığınız için teşekkür ederim

 

[gelen gecer mdmx]

evet sorun hücre birleşikliğindeymiş çok sağolun iyi günler iyi çalışmalar

 

[hsayar]

hsr_ozel&menu_fonk.xla dosyasını C:\Users\kullanıcıadınız\AppData\Roaming\Microsoft \AddIns (vista için)
c:\.................\Microsoft \AddIns (xp için) (eğer işletim sisteminiz xp ise excelde farklı kayde excel eklentisi (*.xla) seçiniz orada çıkan yola kopyalayacaksınız.)

yerleştirdiniz mi?

eklentilerden dosyayı seçtiniz mi?
vba modulünden dosyayı seçtinizmi?
7. mesajdaki örnek dosyayı indirdiniz mi?

dosyalar açılrken makroları entkinleştiri seçtiniz mi?

 

[gelen gecer mdmx]

en fazla D hücresine kadar kopyalıyor.

 

[hsayar]

en fazla D hücresine kadar kopyalıyor.

[LEFT]Sub Worde_Yapistir22()
Dim dosyaadı As String
Range("A1:[B][SIZE=3][COLOR=red]d5[/COLOR][/SIZE][/B]").Select
dosyaadı = "c:\excelde14n.doc"
Selection.Copy: Call SeciliAlaniWordeYapistir(42.55, 42.55, 25, 25, , , dosyaadı)
End Sub[/LEFT]

istediğiniz aralıkta değiştiriniz,
isterseniz,
sonsat = Cells(65536, 2).End(3).Row
Range("A1:d" & sonsat").Select
şeklinde istediğiniz sütunun son hücresini kendi tespit eder öyle yazar.

 

[gelen gecer mdmx]

Range("A1:I5").Select bile yazsam word okadarını alıyor. datatype 3 gibi birşey istiyorum direk o sayfayı resim olarak kopyalasın.mesaj atmıştım size bakmanız mümkünmü?

 

[hsayar]

bu sorun excel dosyanızın sayfa yapsının worde göre iki sayfaya taşmasından kaynaklıdır.
Sayfa yapsıı ölçeklendirmesini %100 yapınız ve sayfa sonu önizlmedede sağa taşan sayfalada klana resim ve grafikleri solda kalan sayfa sınırları içinde tutmanızı öneririm.