Условный разрыв страницы в диапазоне Excel - PullRequest
Новая
       10

Условный разрыв страницы в диапазоне Excel

0 голосов
/ 10 декабря 2018

Надеюсь, это квалифицируется как проблема программирования, учитывая, что я не думаю, что смогу достичь этого без VBA.

У меня есть диапазон Excel 2016, фиксированный по размеру и содержанию (х количество строк), но с учетомвверху есть расширяющийся стол, движется вверх и вниз.По сути, это подпись в конце.

Я хочу не разбивать распечатку этого диапазона на две страницы, поэтому необходимо добавить разрыв страницы перед этим конкретным диапазоном в случае, если часть его переходит на страницу2 - и затем будет полностью напечатан на странице 2, а не только частью диапазона, как это происходит по умолчанию.Кроме того, нет необходимости в этом разрыве страницы, если он не помещается на странице 1.

У меня есть рабочий код, который я мог бы немного улучшить, чтобы вручную добавить разрыв страницы перед диапазоном, но для этого потребуетсязапускаться вручную всякий раз, когда пользователь видит диапазон, частично перетекающий на следующую страницу - возможно, это можно автоматизировать?

Есть идеи относительно возможного подхода? 

Sub Page_break()

    Dim CellRange As Range
    Dim TestCell As Range

    ActiveSheet.ResetAllPageBreaks

    Set CellRange = Selection
    For Each TestCell In CellRange
        If TestCell.Value <> TestCell.Offset(-1, 0).Value Then
            ActiveSheet.Rows(TestCell.Row).PageBreak = xlPageBreakManual
        End If
    Next TestCell

End Sub

1 Ответ

0 голосов
/ 10 декабря 2018

Следующая идея:

  1. Определить диапазон, который вы хотите сохранить вместе RangeToKeep
  2. Перебрать все горизонтальные разрывы страниц
  3. Проверьте, не один ли из нихразрывы страниц пересекаются с RangeToKeep, если это так, вставьте разрыв страницы выше.

Пример: 

Option Explicit

Sub KeepRangeTogether()
    Dim Ws As Worksheet
    Set Ws = Worksheets("Sheet1") 'define worksheet

    Dim RangeToKeep As Range
    Set RangeToKeep = Ws.Range("A23:A37") 'define range you wish to keep together

    Ws.ResetAllPageBreaks 'remove all manual page breaks 
                          '(only needed if this code is run multiple times on the same sheet)

    Dim pb As HPageBreak
    For Each pb In Ws.HPageBreaks 'loop through all page breaks
        If Not Intersect(pb.Location, RangeToKeep) Is Nothing Then 'if a page break intersects your RangeToKeep
            RangeToKeep.EntireRow.PageBreak = xlPageBreakManual 'insert manual page break
            Exit For
        End If
    Next pb
End Sub
...