Word dosyasında boş olan satırları silme

[tamer42]

Merhaba,
Bir word dosyasında boş olan satırları nasıl silebiliriz?

dosyayı yukarıdan aşağıya doğru tarayacak, hiç bir şey olmayan satırları silecek.

ilginize şimdiden teşekkürler,

Spr = Application.PathSeparator
wPath = ThisWorkbook.Path & Spr & "Word"
 wrdDoc = wPath & Spr & "MyNewWordDoc.doc"
With wrdDoc
wrdApp.Visible = True
.....................
...........................
......................................
...........................................
End With
End Sub

Sağlıklı günler....

 

[Haluk]

Aşağıdaki Word VBA makrosunu kendinize uyarlayın...

Sub Test()
    For Each objParagraph In ActiveDocument.Paragraphs
       If Len(objParagraph.Range.Text) = 1 Then
          objParagraph.Range.Delete
       End If
    Next
End Sub

.

 

[Haluk]

Bu da Excel VBA ;

Sub Test()
'   Haluk - 25/04/2020
'   sa4truss@gmail.com

    Dim MyFile As String, MyArg As String
    Dim WdApp As Object, objParagraph As Object
    
    MyFile = ThisWorkbook.Path & Application.PathSeparator & "Test.docx"
    
    If Dir(MyFile) = "" Then
        MsgBox MyFile & " isimli dosya bulunamadı !", vbCritical
        Exit Sub
    End If
    
    Set WdApp = CreateObject("Word.Application")
'    WdApp.Visible = True
    WdApp.Documents.Open MyFile
    
    For Each objParagraph In WdApp.ActiveDocument.Paragraphs
       If Len(objParagraph.Range.Text) = 1 Then
          objParagraph.Range.Delete
       End If
    Next
    
    WdApp.ActiveDocument.Save
    WdApp.ActiveDocument.Close
    WdApp.Quit
    Set WdApp = Nothing
End Sub

.

 

[tamer42]

Aşağıdaki Word VBA makrosunu kendinize uyarlayın...

Sub Test()
    For Each objParagraph In ActiveDocument.Paragraphs
       If Len(objParagraph.Range.Text) = 1 Then
          objParagraph.Range.Delete
       End If
    Next
End Sub

.

Sn haluk ilginize Teşekkürler,
Söz konusu Word dosyası, ekteki örnekte tablo şeklinde olduğu için bu durumda nasıl çözüm üretebiliriz?

iyi haftasonları.....

 

[Haluk]

Tablo Satırı ile dokümandaki Paragraf (satır) tamamen farklı şeyler ....

Aşağıdakini deneyin;

Sub Test2()
'   Haluk - 25/04/2020
'   sa4truss@gmail.com

    Dim MyFile As String, MyArg As String
    Dim WdApp As Object
    
    MyFile = ThisWorkbook.Path & Application.PathSeparator & "Word_Output_ 20200425.docx"
    
    If Dir(MyFile) = "" Then
        MsgBox MyFile & " isimli dosya bulunamadı !", vbCritical
        Exit Sub
    End If
    
    Set WdApp = CreateObject("Word.Application")
'    WdApp.Visible = True
    WdApp.Documents.Open MyFile
    
    Set myTable = WdApp.ActiveDocument.Tables(1)
    
    For i = myTable.Rows.Count To 1 Step -1
        strString = myTable.Rows(i).Cells(1).Range
        If Strings.Len(strString) = 2 Then
            myTable.Rows(i).Delete
        End If
    Next
    
    Set myTable = Nothing
    WdApp.ActiveDocument.Save
    WdApp.ActiveDocument.Close
    WdApp.Quit
    Set WdApp = Nothing
End Sub

 

[tamer42]

Tablo Satırı ile dokümandaki Paragraf (satır) tamamen farklı şeyler ....

Aşağıdakini deneyin;

Sub Test2()
'   Haluk - 25/04/2020
'   sa4truss@gmail.com

    Dim MyFile As String, MyArg As String
    Dim WdApp As Object
   
    MyFile = ThisWorkbook.Path & Application.PathSeparator & "Word_Output_ 20200425.docx"
   
    If Dir(MyFile) = "" Then
        MsgBox MyFile & " isimli dosya bulunamadı !", vbCritical
        Exit Sub
    End If
   
    Set WdApp = CreateObject("Word.Application")
'    WdApp.Visible = True
    WdApp.Documents.Open MyFile
   
    Set myTable = WdApp.ActiveDocument.Tables(1)
   
    For i = myTable.Rows.Count To 1 Step -1
        strString = myTable.Rows(i).Cells(1).Range
        If Strings.Len(strString) = 2 Then
            myTable.Rows(i).Delete
        End If
    Next
   
    Set myTable = Nothing
    WdApp.ActiveDocument.Save
    WdApp.ActiveDocument.Close
    WdApp.Quit
    Set WdApp = Nothing
End Sub

Sn Haluk ilgi ve alakanıza çok teşekkürler,

Müsaadelerinize bir konu daha sorabiliyorum, kalan tablolarda metin fontu bold olmayan satırlarda, satır yüksekliğini nasıl azalta biliriz?

Satır yüksekliği mevcut halinden biraz daha küçük olacak biçimde ekli resimde olduğu şekliyle; "Satır Yüksekliği" Tam olacak şekilde, Metin Fontu Bold olmayan satırlarda bu düzenlemeyi nasıl yapabiliriz?

Sağlıklı günler....

 

[Haluk]

Tablodaki ilk 3 satır boş ve bunlar da silinince tablonun görüntüsü bozuluyor.

O yüzden, söz konusu ilk 3 satırı silmemek sanki daha iyi olur gibi...

Koddaki For-Next döngüsünü aşağıdaki ile değiştirirseniz, iyi olur...

    For i = myTable.Rows.Count To 3 Step -1
        strString = myTable.Rows(i).Cells(1).Range
        If Strings.Len(strString) = 2 Then
            myTable.Rows(i).Delete
        End If
    Next

.

 

[Haluk]

Aşağıdaki kodu deneyebilirsiniz...

Sub Test4()
'   Haluk - 25/04/2020
'   sa4truss@gmail.com

    Dim MyFile As String, MyArg As String
    Dim WdApp As Object
    
    Const wdRowHeightExactly = 2
    
    MyFile = ThisWorkbook.Path & Application.PathSeparator & "Word_Output_ 20200425.docx"
    
    If Dir(MyFile) = "" Then
        MsgBox MyFile & " isimli dosya bulunamadı !", vbCritical
        Exit Sub
    End If
    
    Set WdApp = CreateObject("Word.Application")
'    WdApp.Visible = True
    WdApp.Documents.Open MyFile
    
    Set myTable = WdApp.ActiveDocument.Tables(1)
    
    For i = myTable.Rows.Count To 3 Step -1
        strString = myTable.Rows(i).Cells(1).Range
        If Strings.Len(strString) = 2 Then
            myTable.Rows(i).Delete
        End If
        If myTable.Rows(i).Cells(1).Range.Font.Bold = False Then
            rHeight = myTable.Rows(i).Height
            myTable.Rows(i).SetHeight RowHeight:=rHeight, HeightRule:=wdRowHeightExactly
        End If
    Next
    
    Set myTable = Nothing
    WdApp.ActiveDocument.Save
    WdApp.ActiveDocument.Close
    WdApp.Quit
    Set WdApp = Nothing
End Sub

.

 

[tamer42]

Aşağıdaki kodu deneyebilirsiniz...

Sub Test4()
'   Haluk - 25/04/2020
'   sa4truss@gmail.com

    Dim MyFile As String, MyArg As String
    Dim WdApp As Object
   
    Const wdRowHeightExactly = 2
   
    MyFile = ThisWorkbook.Path & Application.PathSeparator & "Word_Output_ 20200425.docx"
   
    If Dir(MyFile) = "" Then
        MsgBox MyFile & " isimli dosya bulunamadı !", vbCritical
        Exit Sub
    End If
   
    Set WdApp = CreateObject("Word.Application")
'    WdApp.Visible = True
    WdApp.Documents.Open MyFile
   
    Set myTable = WdApp.ActiveDocument.Tables(1)
   
    For i = myTable.Rows.Count To 3 Step -1
        strString = myTable.Rows(i).Cells(1).Range
        If Strings.Len(strString) = 2 Then
            myTable.Rows(i).Delete
        End If
        If myTable.Rows(i).Cells(1).Range.Font.Bold = False Then
            rHeight = myTable.Rows(i).Height
            myTable.Rows(i).SetHeight RowHeight:=rHeight, HeightRule:=wdRowHeightExactly
        End If
    Next
   
    Set myTable = Nothing
    WdApp.ActiveDocument.Save
    WdApp.ActiveDocument.Close
    WdApp.Quit
    Set WdApp = Nothing
End Sub

.

Çok teşekkürler,

 

[tamer42]

Tablodaki ilk 3 satır boş ve bunlar da silinince tablonun görüntüsü bozuluyor.

O yüzden, söz konusu ilk 3 satırı silmemek sanki daha iyi olur gibi...

Koddaki For-Next döngüsünü aşağıdaki ile değiştirirseniz, iyi olur...

    For i = myTable.Rows.Count To 3 Step -1
        strString = myTable.Rows(i).Cells(1).Range
        If Strings.Len(strString) = 2 Then
            myTable.Rows(i).Delete
        End If
    Next

.

Haluk Hocam tekrar merhaba,

işlemi yaptıktan sonra en altta tabloların altında bir kaç satır boşluk geliyor, bunları Backspace ile geri alıyorum, bu işlemi kod ile yapabilir miyiz,
Ekli dosyada; "en alt satıra gir, bu satırda bir şey yazmıyorsa bir kere Backspace işlemi yap"

teşekkürler, iyi haftasonları....

 

[Haluk]

O iş için de 3 No'lu mesajdaki kodu kullansanız...?

.