Word'deki tablolari Excell'e aktarmak

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba arkadaslar,
Benim elimde bir word dosyasi var. Kendi calismalarimla igili bir rapor. Sayfa sayisi oldukca fazla ve icerisindeki tablolar da kopyala yapistir yontemi ile uzun zaman alacak kadar fazla.

Word dosyamdaki tablolari excell e satir sutun sayisi degismeden aktarmanin kolay bir yolu var midir? 100 den fazla tablo var.simdiden tesekkur ederim.
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba Sn. asri
verdiğiniz linkteki dosyayı inceledim fakat bu makro çalıştırılamaz hatası alıyorum. Sanırım ben bir yerlerde yanlışlık yaptım. Aşağıya örnek dosyayı ekliyorum. Word dosyası içindeki Başlıkları,tabloları ve tablo numaralarını excell'e aktarmak istiyorum.
Örneğin ; A1 Noktası Ceyhan Nehri gibi başlıklar ile o başlığın altındaki tablo ve tablo numaralarını aktarmam lazım. yaklaşık 400 450 tane tablo olduğu için yardımlarınızı talep ediyorum. Teşekkür ederim.

Örnek Dosya : http://dosya.co/owm3rxaik9jy/deneme.docx.html
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Örnek bir dosya olmadan nasıl cevaplayalım ki?

Linkteki dosyayı inceleyiniz.

http://asriakdeniz.com/wordden-excele-tablo-kopyalama
Merhaba Sn. asri
verdiğiniz linkteki dosyayı inceledim fakat bu makro çalıştırılamaz hatası alıyorum. Sanırım ben bir yerlerde yanlışlık yaptım. Aşağıya örnek dosyayı ekliyorum. Word dosyası içindeki Başlıkları,tabloları ve tablo numaralarını excell'e aktarmak istiyorum.
Örneğin ; A1 Noktası Ceyhan Nehri gibi başlıklar ile o başlığın altındaki tablo ve tablo numaralarını aktarmam lazım. yaklaşık 400 450 tane tablo olduğu için yardımlarınızı talep ediyorum. Teşekkür ederim.

Örnek Dosya : http://dosya.co/owm3rxaik9jy/deneme.docx.html
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Bu kodu Word deki vba modülüne kopyalayın.
Çalıştırdığınızda, koyu olan satırları, satır içinde "Fitobentoz Türleri, Sayıları ve Biyohacimleri" cümlesi geçenleri ve tabloları silmeyecek.
Diğer tüm satırları ve boş satırları silecektir.

Daha sonra tümünü kopyalayın ve excel e yapıştırın.

Word dosyasında bazı satırlarda ""Fitobentoz Türleri, Sayıları ve Biyohacimleri" var iken,
bazı satırlarda "Fitobentoz Türleri Sayıları ve Biyohacimleri" virgülsüz olarak geçiyor. Program bunu tespit edemez.

Ortak nokta "Fitobentoz Türleri" ise aşağıdaki metni bu şekilde değiştiriniz.


Kod:
Sub gereksiz_sil()
  Dim p As Paragraph
  For Each p In ActiveDocument.Paragraphs
    If Not p.Range.Information(wdWithInTable) Then
       If p.Range.Font.Bold = False And InStr(p.Range.Text, "Fitobentoz Türleri, Sayıları ve Biyohacimleri") = 0 Then
          p.Range.Delete
       End If
    End If
  Next
End Sub
 
Son düzenleme:

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Bu kodu Word deki vba modülüne kopyalayın.
Çalıştırdığınızda, koyu olan satırları, satır içinde "Fitobentoz Türleri, Sayıları ve Biyohacimleri" cümlesi geçenleri ve tabloları silmeyecek.
Diğer tüm satırları ve boş satırları silecektir.

Daha sonra tümünü kopyalayın ve excel e yapıştırın.

Word dosyasında bazı satırlarda ""Fitobentoz Türleri, Sayıları ve Biyohacimleri" var iken,
bazı satırlarda "Fitobentoz Türleri Sayıları ve Biyohacimleri" virgülsüz olarak geçiyor. Program bunu tespit edemez.

Ortak nokta "Fitobentoz Türleri" ise aşağıdaki metni bu şekilde değiştiriniz.


Kod:
Sub gereksiz_sil()
  Dim p As Paragraph
  For Each p In ActiveDocument.Paragraphs
    If Not p.Range.Information(wdWithInTable) Then
       If p.Range.Font.Bold = False And InStr(p.Range.Text, "Fitobentoz Türleri, Sayıları ve Biyohacimleri") = 0 Then
          p.Range.Delete
       End If
    End If
  Next
End Sub
Yardımlarınız için çok teşekkür ederim. Verdiğiniz kod sayesinde sorunum çözülmüştür. Ellerinize sağlık
 
Üst