Word Belgesindeki Boş satırları kaldırmak

asdsxx · 28 Mart 2024

word dosyasında boş satırları nasıl kaldırabiliriz.
Yalnız benim kasteddiğim

sadece "Enter" tuşu ile açılan boş satırlar değil,
boş satırlarda "boşluk tuşu" ile çeşitli sayılarda karakter görünüyor.

Üst resimde görüldüğü gibi aslında satır dolu gibi olduğundan "Bul değiştir" deki yöntem çalışmıyor. ama sadece boşluk tuşu ile " space" yapıldığı için boş. Bu gibi (aslında boş olmayan) ama sadece baoluk tuşu ile dolu görünen boş satırları toplu olarak nasıl yok edebiliriz.

necati · 28 Mart 2024

Merhaba,
Boş paragrafları ve boşluk basılı olan paragrafları siler.

Kod:

Sub BosParagraflar()
Dim prg As Paragraph

For Each prg In ActiveDocument.Paragraphs
    If prg.Range.ComputeStatistics(Statistic:=3) = 0 Then
        prg.Range.Delete
    End If
Next

MsgBox "İşlem tamamlandı.", vbInformation

End Sub

asdsxx · 28 Mart 2024

necati' Alıntı:
Merhaba,
Boş paragrafları ve boşluk basılı olan paragrafları siler.

Kod:

Sub BosParagraflar() Dim prg As Paragraph For Each prg In ActiveDocument.Paragraphs If prg.Range.ComputeStatistics(Statistic:=3) = 0 Then prg.Range.Delete End If Next MsgBox "İşlem tamamlandı.", vbInformation End Sub

Necati Bey çok teşekkür ederim. İstediğim bu idi.

Bu kod'a bir ilave yaparak word dosyasının bir bölümünde Mesela

stiller kısmından "Dipnot" kısmındaki yerleri düzeltmek için bir ilave eklenebilir mi

necati · 28 Mart 2024

Stillere ne ilave etmek istiyorsunuz? Biraz daha açar mısınız?

asdsxx · 28 Mart 2024

necati' Alıntı:
Stillere ne ilave etmek istiyorsunuz? Biraz daha açar mısınız?

Mesela aktif word dosyanın tamamında değil de word dosyasının içinde benim dipnot stili olarak belirlediğim (aslında dipnıt değil) bölümlerde bu satırlar var. Sadece o kısımlarda arama yapıp düzeltmesi için "select dipnot" gibi bir kod satırı eklenebilir mi?
Mevcut kod çalışıyor ama benim istemediğim bazı değişiklikler de yapıyor. Mesela "CTRL+Enter" ile sayfa başı yaptığım yerleri iptal edip normal sayfada paragraf haline getiriyor. Ve tekrar tüm çalışmayı gözden geçirmek durumu ortaya çıkıyor.

necati · 28 Mart 2024

Küçük bir örnek harici siteye eklemek mümkün mü?

asdsxx · 28 Mart 2024

necati' Alıntı:
Küçük bir örnek harici siteye eklemek mümkün mü?

Bul değiştirdeki şeklin kod olarak yazılması. Yukarıdaki yöntem ile sadece dipnot stili ile biçimlendirilen boş satırları kaldırıyor. dosyanın diğer bölümlerdeki boş satırlara dokunmuyor. Ama "space" tuşu ile bir veya daha fazla karakterli boş satırları kaldırmıyor.

necati · 29 Mart 2024

Sadece kodda belirtilen tipteki stillerde boş paragrafları silmek:

Kod:

Sub BosParagraflarStillerde()
Dim prg As Paragraph

For Each prg In ActiveDocument.Paragraphs
    If prg.Style = ActiveDocument.Styles("Dipnot") And _
        prg.Range.ComputeStatistics(Statistic:=3) = 0 Then
        prg.Range.Delete
    End If
Next

MsgBox "İşlem tamamlandı.", vbInformation

End Sub

asdsxx · 29 Mart 2024

necati' Alıntı:

Sadece kodda belirtilen tipteki stillerde boş paragrafları silmek:

Kod:

Sub BosParagraflarStillerde()
Dim prg As Paragraph

For Each prg In ActiveDocument.Paragraphs
    If prg.Style = ActiveDocument.Styles("Dipnot") And _
        prg.Range.ComputeStatistics(Statistic:=3) = 0 Then
        prg.Range.Delete
    End If
Next

MsgBox "İşlem tamamlandı.", vbInformation

End Sub

Çok teşekkür ederim Necati Bey

asdsxx · 29 Mart 2024

necati' Alıntı:

Sadece kodda belirtilen tipteki stillerde boş paragrafları silmek:

Kod:

Sub BosParagraflarStillerde()
Dim prg As Paragraph

For Each prg In ActiveDocument.Paragraphs
    If prg.Style = ActiveDocument.Styles("Dipnot") And _
        prg.Range.ComputeStatistics(Statistic:=3) = 0 Then
        prg.Range.Delete
    End If
Next

MsgBox "İşlem tamamlandı.", vbInformation

End Sub

Necati Bey İlginize çok teşekkür ederim
örnek dosyada parantez içinde rakamlar var o rakamları dipnot olarak çevirip, "Dipnot metni" olarak belirtilen kısımlardan o metinlerin alınıp dipnot olarak sayfanın altına eklene bilir mi acaba

https://s6.dosya.tc/server19/ng152k/ornek.docx.html

necati · 30 Mart 2024

Kod:

Sub dipnotaCevirmek()
Dim dipRef(), dipMet(), adet
Dim i As Integer, say As Integer
Dim orijinalRange As Range
Dim yaz As Boolean

Application.ScreenUpdating = False
adet = InputBox("Kaç adet Dipnot eklenecek giriniz!", "Sayı Girme")
If StrPtr(adet) = 0 Or adet <= 0 Or Not IsNumeric(adet) Then
Exit Sub
End If

ActiveDocument.Footnotes.NumberingRule = wdRestartSection
Set orijinalRange = Selection.Range
say = ActiveDocument.Footnotes.Count

With Selection
10:
        .Find.ClearFormatting
        .Find.Font.Superscript = True
        .Find.Font.Color = wdColorRed
        .Find.Replacement.Text = ""

For i = 1 To adet
        .Find.Text = i
        .Find.Execute
        If .Find.Found = True Then
            If yaz = False Then
                ReDim Preserve dipRef(i - 1)
                dipRef(i - 1) = .Text
                .Collapse Direction:=wdCollapseEnd
            Else
                .MoveRight Unit:=wdCharacter, Count:=2
                ActiveDocument.Footnotes.Add Range:=.Range, Text:="- " & dipMet(i - 1)
                say = say + 1
                ActiveDocument.Footnotes(say).Reference.Font.ColorIndex = wdBlack
            End If
        End If
Next
If yaz = True Then GoTo 20
        .Find.ClearFormatting
        .Find.Font.Color = wdColorRed
        .Find.Replacement.Text = ""

For i = 1 To adet
        .Find.Text = i
        .Find.Execute
        If .Find.Found = True Then
            .MoveRight Unit:=wdWord, Count:=2
            .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
            .MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            .EscapeKey
            ReDim Preserve dipMet(i - 1)
            dipMet(i - 1) = .Text
            .Collapse Direction:=wdCollapseEnd
        End If
Next
        orijinalRange.Select
        yaz = True
GoTo 10
End With

20:
Application.ScreenUpdating = True
MsgBox i - 1 & "  Adet dipnot eklendi", vbInformation

End Sub

Örnekte bazı bölüm sonlarında "sayfa sonu" konulmuş, bunlar "bölüm sonu" olarak değiştirilmeli.
İmleç ilk bölümün ilk sayfasında iken makro çalışınca inputbox çıkar.
Birinci bölüm için dipnot adedini giriyoruz ve enter yapıyoruz.
Tamamlanınca rapor mesajı çıkar. Sonra ikinci bölümün başına gelip aynı şeyi yapıyoruz.
Kontrol etmeniz için eski numaralar olduğu gibi bırakıldı.

asdsxx · 30 Mart 2024

necati' Alıntı:

Kod:

Sub dipnotaCevirmek()
Dim dipRef(), dipMet(), adet
Dim i As Integer, say As Integer
Dim orijinalRange As Range
Dim yaz As Boolean

Application.ScreenUpdating = False
adet = InputBox("Kaç adet Dipnot eklenecek giriniz!", "Sayı Girme")
If StrPtr(adet) = 0 Or adet <= 0 Or Not IsNumeric(adet) Then
Exit Sub
End If

ActiveDocument.Footnotes.NumberingRule = wdRestartSection
Set orijinalRange = Selection.Range
say = ActiveDocument.Footnotes.Count

With Selection
10:
        .Find.ClearFormatting
        .Find.Font.Superscript = True
        .Find.Font.Color = wdColorRed
        .Find.Replacement.Text = ""

For i = 1 To adet
        .Find.Text = i
        .Find.Execute
        If .Find.Found = True Then
            If yaz = False Then
                ReDim Preserve dipRef(i - 1)
                dipRef(i - 1) = .Text
                .Collapse Direction:=wdCollapseEnd
            Else
                .MoveRight Unit:=wdCharacter, Count:=2
                ActiveDocument.Footnotes.Add Range:=.Range, Text:="- " & dipMet(i - 1)
                say = say + 1
                ActiveDocument.Footnotes(say).Reference.Font.ColorIndex = wdBlack
            End If
        End If
Next
If yaz = True Then GoTo 20
        .Find.ClearFormatting
        .Find.Font.Color = wdColorRed
        .Find.Replacement.Text = ""

For i = 1 To adet
        .Find.Text = i
        .Find.Execute
        If .Find.Found = True Then
            .MoveRight Unit:=wdWord, Count:=2
            .MoveDown Unit:=wdParagraph, Count:=1, Extend:=wdExtend
            .MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            .EscapeKey
            ReDim Preserve dipMet(i - 1)
            dipMet(i - 1) = .Text
            .Collapse Direction:=wdCollapseEnd
        End If
Next
        orijinalRange.Select
        yaz = True
GoTo 10
End With

20:
Application.ScreenUpdating = True
MsgBox i - 1 & "  Adet dipnot eklendi", vbInformation

End Sub

Örnekte bazı bölüm sonlarında "sayfa sonu" konulmuş, bunlar "bölüm sonu" olarak değiştirilmeli.
İmleç ilk bölümün ilk sayfasında iken makro çalışınca inputbox çıkar.
Birinci bölüm için dipnot adedini giriyoruz ve enter yapıyoruz.
Tamamlanınca rapor mesajı çıkar. Sonra ikinci bölümün başına gelip aynı şeyi yapıyoruz.
Kontrol etmeniz için eski numaralar olduğu gibi bırakıldı.

Necati Bey Çok, Çok teşekkür ederim.
Ellerine sağlık
Allah senden razı olsun.

necati · 30 Mart 2024

Rica ederim, bil mukabele.