Word Dosyasındaki Farklı Tablo Formatlarındaki tabloları Excel'e Kaydetme

[cellswhite]

İyi çalışmalar arkadaşlar,

Sayısı olarak net bir rakam veremeyeceğim miktarda Word dosyası içerisinde farklı yapıda tablolarım var. ( Başlıkları ve dipnotları dahil )
Bu tabloların formatlarını bozmadan excel'e herbir tablo için ayrı sheet açarak verileri aktarmak istiyorum.
Ekte kaynak olarak kullanacağımız bir word(*.doc) ve birde copy yaparak almış oldugum ornek tabloları içeren excel(*.xls) dosyası var.

Word dosyası içerisindeki tabloları excele taşıyacak bir macro ile çözüme ulaşılabilir kanısındayım.
Bu konuda yardımcı olabilEcek arkadaşlara teşekkur ederim.

İyi çalışmalar.

 

[cellswhite]

Merhaba,

Farklı bir örnek.Umarım çözümü vardır diye düşünüyorum.

 

[hamitcan]

Bir deneme yaptım, başarılı oldu. Umarım, aksaklık çıkmaz.

Sub word_to_excel2()
'Tabloları Kopyala
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.WorkSheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    
    For Each tbl In ActiveDocument.Tables
    Set xlSheet = xlBook.Sheets.Add
    tbl.Select
    Selection.Copy
    xlSheet.[a1].Activate
    xlSheet.Paste
    Set xlSheet = Nothing
        Next tbl
    xlApp.Visible = True
End Sub

 

[cellswhite]

Hamit Bey selamlar,

Oncelikle emeğiniz için teşekkurler yalnız.Birkaç eksik var desem umarım çözebiliriz.

Ornek excel dosyası içerisinde belirtiğim gibi olan tablolar var ( Tabloların 1-2 satır üstünde ve varsa eğer * - ** - *** gibi başlayan satırlarıda dahil etmemiz gerekiyor.

Eğer bu konuda da destek verirseniz çok makbule geçecektir.

İyi çalışmalar.

 

[hamitcan]

"*" karakteri ile başlayan notları da tabloya dahil etsek, satırdaki kenarlıkları da kaldırsak, sorun çözülür diye düşünüyorum.

 

[cellswhite]

Hamit Bey ,
Bu konuda haklısınız.Yalnız tablolar daha öncesinden word dosyasına aktarıldıgından dolayı bu fazlasıyla zaman alacaktır.Tahmini olarak bir word dosyasında 200+ tablo var.

Tamamen atıyorum ; Kodu excel'e modifiye etsek , Word dosyasından tablalların başlangıç satırını bulsak (üst başlık için 2 satır ) alt başlık için (tablonun bitiş satırının 2 satırı alsak) bunun yanında tablonun satır ve kolon sayısına göre dongu ile ilerlememiz mümkünmüdür.

Alternatif önerinize herzaman açığım.

İyi çalışmalar.

 

[hamitcan]

Bir kaç deneme yapacağım, olumlu sonuç elde edersem eklerim.

 

[hamitcan]

Kusura bakmayın, bir mantık geliştiremedim.

 

[cellswhite]

Hamit Bey,

Kodda bir değişiklik yaparak şu şekilde revize ettim.Buradan birşeyler çıkarabilirmiyiz.

Sub word_to_excel_dongulu_alma()
'Tabloları Kopyala
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.WorkSheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    xlApp.Visible = True
    veri = ActiveDocument.Tables.Count
    For y = 1 To veri
    Set xlSheet = xlBook.Sheets.Add
    sat = ActiveDocument.Tables(y).Rows.Count
    kol = ActiveDocument.Tables(y).Columns.Count
    For p = 1 To sat
    For k = 1 To kol
    xlSheet.Cells(p, k) = ActiveDocument.Tables(y).Cell(p, k)
    xlSheet.Cells(p, k) = WorksheetFunction.Clean(Trim(xlSheet.Cells(p, k)))
    Next
    Next
    Next
    xlApp.Visible = True
End Sub

İşlemi dongu ile alabildiğimiz durumda table'ın başlangıc satırını bulabilirsek.uste doğru 2 satır alta doğru 2 satır ıda taşıyarak ilerleyebiliriz.

Tekrar vakit ayırabilirseniz sevinirim.

İyi çalışmalar

 

[hamitcan]

Tabloların 1-2 satır üstünde ve varsa eğer * - ** - *** gibi başlayan satırlarıda dahil etmemiz gerekiyor.

Bana göre bu satırları tespit etmek zor görünüyor, çünkü belli bir standardı yok gibi.(Kimisi üç, kimisi iki, kimisi bir tane not içeriyor). Bu satırları tespit etseniz dahi ilgili tablo ile eşleştirmeniz gerekiyor. Kısaca, yazacağınız kodu çok iyi tasarlamanız gerekiyor. Ayrıca, çok incelemedim ama, verdiğiniz kod zannedersem tablonun formatını aktarmıyor.

Sanki, dokümanın tamamı, Excel içine aktarılıp, burada ayrıştırılsa, çözülecek gibi görünüyor.

 

[cellswhite]

Hamit Bey,

Desteğiniz için çok teşekkurler.Bu kadarıda ışık tutmak için yeterli oldu.Tekrar tekrar teşekkurler.

İyi çalışmalar.

NOT:Konu üzerinde ilerlersem size donus yapacağım.