• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru Birleşmiş Hücre ve Sayfa Sonu

  • Konbuyu başlatan Konbuyu başlatan hlojan
  • Başlangıç tarihi Başlangıç tarihi
Katılım
15 Mayıs 2015
Mesajlar
518
Excel Vers. ve Dili
Microsoft Office 2019
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
 
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
 
Geri
Üst