VBA Excel：是否可以计算命名范围内的水平分页符？

Question

我有很多自动生成的报告，每个报告包含 24 个命名范围。

每个命名范围不能被水平分页符打破。

我的想法是遍历所有命名范围并计算其中的分页符。

但我找不到一种方法来计算指定范围内的分页符。

有人知道这是否可能吗？

编辑：感谢您的建议。希望圣诞节前能抽出时间来测试一下，不然一月回来回答。

Answer 1

欢迎来到 SO。可以简单地扫描命名范围，然后扫描范围的行以查找已经存在的分页符。但恐怕这是一个缓慢的过程，并且可能需要很长时间才能在具有许多长命名范围的文件中。请根据您的要求进行修改。

Sub test()
Dim Rw As Range
Dim RngStr As String, Nm As Name

    For Each Nm In ThisWorkbook.Names
    RngStr = Nm.Name
        For Each Rw In Range(RngStr).Rows
            If Rw.PageBreak <> xlNone Then
            Debug.Print RngStr & " on " & Range(RngStr).Address(, , , True) & " has a Pagebreak at Row " & Rw.Row
            End If
        Next Rw
    Next Nm

End Sub

Answer 2

继续我对@VBasic2008 答案的评论，并公然捏捏他的Intersect 想法，我发现这行得通：

Sub CountBreaks()

    Dim nr As Name
    Dim Hpb As HPageBreak
    Dim Vpb As VPageBreak
    Dim h As Long, v As Long

    'May need some method to look at a select number of named ranges.
    For Each nr In ThisWorkbook.Names

        For Each Hpb In nr.RefersToRange.Parent.HPageBreaks
            If Not Intersect(Range(Hpb.Location.Address).EntireRow, _
                             Range(nr.RefersToRange.Address)) Is Nothing Then
                h = h + 1
            End If
        Next Hpb

        For Each Vpb In nr.RefersToRange.Parent.VPageBreaks
            If Not Intersect(Range(Vpb.Location.Address).EntireColumn, _
                             Range(nr.RefersToRange.Address)) Is Nothing Then
                v = v + 1
            End If
        Next Vpb

        MsgBox nr.Name & " has: " & vbCr & _
            h & " horizontal page breaks." & vbCr & _
            v & " vertical page breaks.", vbOKOnly + vbInformation

        h = 0
        v = 0

    Next nr

End Sub

我希望我的工作表限定是正确的 - 即我认为 Range(Hpb.Location.Address) 也指的是正确的工作表。

评论中的.PageSetup.PrintArea = nmAddress 不需要 - 只是因为我的工作表上没有任何数据而出现问题。

Answer 3

PB 地狱

我建议你先研究一下这个命名范围的代码，然后你会很容易地为它们创建一个循环。

Sub PageBr()

  Const cStrName As String = "HPBr"
  Const cStrRange As String = "B50:B250"
  Dim nmAddress As String
  Dim i As Integer
  Dim j As Integer

  With Sheet1

    ' Define a name (Refers to ThisWorkbook (.Parent)).
    .Parent.Names.Add cStrName, .Range("B50:B250")
    nmAddress = .Parent.Names(cStrName).RefersToRange.Address

    ' Add horizontal pagebreaks.
    With .HPageBreaks
      .Add Before:=.Parent.Range("A59")
      .Add Before:=.Parent.Range("B159")
      .Add Before:=.Parent.Range("A248")
      .Add Before:=.Parent.Range("D269")
    End With

    ' Range version
    For i = 1 To .HPageBreaks.Count
      If Not Intersect(.Range(.HPageBreaks(i).Location.Address) _
          .Resize(, .Columns.Count), .Range(nmAddress)) Is Nothing Then
        j = j + 1
      End If
    Next
    Debug.Print "The named range '" & cStrName & "' contains " & j _
        & " horizontal pagebreaks."

    ' Row version
    Dim pbRow As Long
    Dim nmRow1 As Long
    Dim nmRow2 As Long

    nmRow1 = .Range(nmAddress).Row
    nmRow2 = .Range(nmAddress).Rows.Count + .Range(nmAddress).Row - 1

    j = 0
    For i = 1 To .HPageBreaks.Count
      pbRow = .Range(.HPageBreaks(i).Location.Address).Row
      If pbRow >= nmRow1 And pbRow <= nmRow2 - 1 Then
        j = j + 1
      End If
    Next
    Debug.Print "The named range '" & cStrName & "' contains " & j _
        & " horizontal pagebreaks."

  End With

End Sub