Soru Birleşmiş Hücre ve Sayfa Sonu

Katılım
15 Mayıs 2015
Mesajlar
518
Excel Vers. ve Dili
Microsoft Office 2019
Altın Üyelik Bitiş Tarihi
26/06/2023
Merhaba

Birlişmiş hücreler sayfa sonlarında 2 ye bölünmesin diye bir kodu var

Bunu sadece belirli bir range uygulamak istiyorum range("a100:s104") gibi

YArdımcı olurmusunuz
Kod:
Dim sh As Worksheet
Dim NextPageBreakNumber As Long
Dim PageBreakFirstLine  As Object
Dim LineNumber As Long
Set sh = ThisWorkbook.ActiveSheet
ActiveWindow.View = xlPageBreakPreview
sh.ResetAllPageBreaks
NextPageBreakNumber = 1
While NextPageBreakNumber <= sh.HPageBreaks.Count
    Set PageBreakFirstLine = sh.HPageBreaks(NextPageBreakNumber).Location
    LineNumber = PageBreakFirstLine.Row
    If sh.Cells(LineNumber, 1).MergeCells = True Then
        Set sh.HPageBreaks(NextPageBreakNumber).Location = sh.Cells(sh.Cells(LineNumber, 1).MergeArea.Row, 1)
    End If
    NextPageBreakNumber = NextPageBreakNumber + 1
Wend
ActiveWindow.View = xlNormalView
 

Muzaffer Ali

Destek Ekibi
Destek Ekibi
Katılım
5 Haziran 2006
Mesajlar
6,428
Excel Vers. ve Dili
2019 Türkçe
Merhaba.

Deneyiniz.

Kod:
Sub test()
Dim sh As Worksheet
Dim NextPageBreakNumber As Long
Dim PageBreakFirstLine  As Object
Dim LineNumber As Long
Set sh = ThisWorkbook.ActiveSheet
ActiveWindow.View = xlPageBreakPreview

sh.ResetAllPageBreaks
NextPageBreakNumber = 1

While NextPageBreakNumber <= sh.HPageBreaks.Count
    Set PageBreakFirstLine = sh.HPageBreaks(NextPageBreakNumber).Location
    LineNumber = PageBreakFirstLine.Row
    If Not Intersect(sh.Cells(LineNumber, 1), Range("a100:s104")) Is Nothing And sh.Cells(LineNumber, 1).MergeCells = True Then
        Set sh.HPageBreaks(NextPageBreakNumber).Location = sh.Cells(sh.Cells(LineNumber, 1).MergeArea.Row, 1)
    End If
    NextPageBreakNumber = NextPageBreakNumber + 1
Wend
ActiveWindow.View = xlNormalView
End Sub
 
Üst