通过VBA打开Excel页面 [英] Excel page breaks via VBA

问题描述

作为对报表生成器进行大修的一部分，我看到了我认为是低效的代码。该部分代码在生成主报表之后运行，以便在逻辑位置设置分页符。标准是这样的：

As part of an overhaul of a report generator I saw what I believed to be inefficient code. This part of the code runs after the main report is generated to set the page breaks in logical positions. The criteria is this:

• 每个网站都在新页面上开始。


• 允许在页面上打破。

代码遵循以上格式：2个循环执行这些作业。

The code follows the above format: 2 loops doing those jobs.

这是原始代码（对于长度不好）：

This is the original code (sorry for the length):

Public Sub PageBreak(ByRef wstWorksheet As Excel.Worksheet, ByVal pctProgress As ProgressCtl.ProgressControl)
Dim breaksMoved As Integer
Dim p As HPageBreak
Dim i As Integer

'Used as a control value
breaksMoved = 1

' Marks that no rows/columns are to be repeated on each page
wstWorksheet.Activate
wstWorksheet.PageSetup.PrintTitleRows = ""
wstWorksheet.PageSetup.PrintTitleColumns = ""

'If this isn't performed beforehand, then the HPageBreaks object isn't available
Range("A3").Select
ActiveWindow.View = xlPageBreakPreview

'Defaults the print area to be the entire sheet
wstWorksheet.DisplayPageBreaks = False
wstWorksheet.PageSetup.PrintArea = ""

Range("$B$4").Select

' add breaks after each site
Do While ActiveCell.Row <= wstWorksheet.UsedRange.Rows.Count
    If ActiveCell.FormulaR1C1 = "Site ID" Then
        ActiveCell.PageBreak = xlPageBreakManual
    End If
    ActiveCell.Offset(1, 0).Activate
    pctProgress.ProgressText = "Row " & CStr(ActiveCell.Row) & " of " & CStr(wstWorksheet.UsedRange.Rows.Count)
Loop

Dim passes As Long
Do While breaksMoved = 1
    passes = passes + 1
    breaksMoved = 0
    For i = 1 To wstWorksheet.HPageBreaks.Count - 1
            Set p = wstWorksheet.HPageBreaks.Item(i)
            'Selects the first page break
            Range(p.Location.Address).Select
            'Sets the ActiveCell to 1 row above the page break
            ActiveCell.Offset(-1, 0).Activate

            'Move the intended break point up to the first blank section
            Do While Not ActiveCell.FormulaR1C1 = ""
                ActiveCell.Offset(-1, 0).Activate
                breaksMoved = 1
            Loop

            'Add the page break
            If ActiveCell.FormulaR1C1 <> "Site ID" Then
                ActiveCell.Offset(1, 0).Activate
                wstWorksheet.HPageBreaks.Add ActiveCell
            End If

            pctProgress.ProgressText = "Set break point " & CStr(passes) & "." & CStr(i)

    Next

Loop

'Reset the view to normal
wstWorksheet.DisplayPageBreaks = True
ActiveWindow.View = xlNormalView
Range("A3").Select
End Sub

Seeing room for improvement I set about modifying this. As one of the new requirements the people wanting the report were manually removing pages prior to printing. So I added checkboxes on another page and copied the checked items across. To ease that I used named ranges. I used these named ranges to meet the first requirement:

' add breaks after each site   
For Each RangeName In ActiveWorkbook.Names
    If Mid(RangeName.Name, 1, 1) = "P" Then
        Range(RangeName).Activate
        ActiveCell.Offset(Range(RangeName).Rows.Count - 1, 0).Select
        ActiveCell.PageBreak = xlPageBreakManual
    End If
Next RangeName

所有范围都以P_（父）为前缀。使用跛脚Now（）风格的粗略时机，这是我的短4站点报告和更具挑战性的15站点报告慢1秒。这些分别有606和1600行。

All Ranges are prefixed with P_ (for parent). Using the lame Now() style of rough timing this is 1 second slower on my short 4 site report and the more challenging 15 site report. These have 606 and 1600 rows respectively.

1秒没有那么糟糕。让我们来看下面的标准。
每个逻辑组被一个空白行分开，所以最简单的方法是找到下一个分页符，一直返回，直到找到下一个空行并插入新的中断。冲洗并重复。

1 second isn't so bad. Lets look at the next criteria. Each logical group is split by a blank row, so the easiest way is to find the next page break, step back until you find the next blank line and insert the new break. Rinse and repeat.

那么为什么原来多次运行？我们也可以改善（循环之外的锅炉板是一样的）。

So why does the original run through multiple times? We can improve that too (the boiler plate outside the loops is the same).

Dim i As Long
Dim oPageBreak As HPageBreak
Do While i < shtDeliveryVariance.HPageBreaks.Count - 1
    i = i + 1
    pctProgress.ProgressText = "Setting Page Break " & CStr(i) & " of " & CStr(shtDeliveryVariance.HPageBreaks.Count)

    Set oPageBreak = shtDeliveryVariance.HPageBreaks.Item(i)

    ' select the page break
    Range(oPageBreak.Location.Address).Select
    ActiveCell.Offset(-1, 0).Activate

    ' move up to a free row
    Do While Not ActiveCell.FormulaR1C1 = ""
        ActiveCell.Offset(-1, 0).Activate
    Loop

    'Add the page break
    If ActiveCell.FormulaR1C1 <> "Site ID" Then
        ActiveCell.Offset(1, 0).Activate
        shtDeliveryVariance.HPageBreaks.Add ActiveCell
    End If

Loop

一次通过也更优雅。但是要多快呢？在小测试中，与原始45秒相比需要54秒，而在较大的测试中，我的代码在153到130秒内再次较慢。而且这也是3次的平均值。

One pass and more elegant too. But how much quicker is it? On the small test is takes 54 seconds compared to the original 45 seconds, and on the larger test my code is slower again at 153 to 130 seconds. And this is averaged over 3 runs too.

所以我的问题是：为什么我的新代码比原来慢得多，尽管我看起来更快>和我可以做些什么来加快代码的缓慢时间？

So my questions are: Why is my newer code so much slower than the original despite mine looking faster and what can I do to speed up the slowness of the code?

注意：Screen.Updating，等等已经在计算等等。

Note: Screen.Updating, etc. is already off as is Calculation etc.

推荐答案

我看到你的代码中有几个点的改进空间： p>

I see room for improvement in a couple spots in your code:

1. 不要访问慢速实现的属性，如usedrange.rows.count不止一次（特别是循环内），除非您认为它们可能有变化


2. 如果可以避免这种情况，请勿执行文本比较（例如：.Value =），而是使用LenB函数来检查空白将执行得更快，因为它只是读取字符串头的长度，而不是逐字节逐字串比较。 （您可能会喜欢此阅读。）


3. 不要使用激活或选择来移动ActiveCell，只需直接访问该范围。


4. 循环时，将循环结构化以尽可能少地执行测试。如果循环必须总是执行一次，那么你需要一个后测循环。


5. 确保您的Excel界面已锁定，运行事件和屏幕更新等可能会使您的代码减慢很多。 （特别是事件）


6. 最后，我注意到你对网站ID的情况做出了假设，除非没有可能的方式，否则，最好做不区分大小写的比较。如果你知道一个事实，它将是这样的方式，你当然可以删除对我添加的LCase $的调用。

1. Don't access properties that are implemented slowly, like usedrange.rows.count more than once(particularly inside a loop) unless you think they may have changes. Instead store them in a variable.
2. Don't do text comparisons if you can avoid it (Ex: .Value = ""), instead use the LenB function to check for emptiness, it will execute faster as it's just reading the length of the string header instead of launching into a byte by byte string comparison. (You might enjoy this for reading.)
3. Don't use "Activate" or "Select" to move around the ActiveCell, just access the range directly.
4. When looping, structure your loop to have to perform as few tests as possible. If the loop must always execute once, then you want a post-test loop.
5. Make sure you have the Excel interface locked, as running events and screen-updating etc, can slow your code down a lot. (Especially events.)
6. Finally, I noticed that you are making assumptions about the case of "Site ID", unless there is no possible way it could be cased otherwise, it's best to do a case insensitive comparison. If you know for a fact that it will be Cased that way you can of course remove the calls to LCase$ that I added.

我重写了原始的代码，给出了一些这些想法的例子。不知道你的数据布局，很难确定这个代码是100％有效，所以我会仔细检查一下逻辑错误。但是它应该让你开始。

I refactored the original code to give you an example of some of these ideas. Without knowing your data layout, it's hard to be sure if this code is 100% valid, so I would double check it for logic errors. But it should get you started.

Public Sub PageBreak(ByRef wstWorksheet As Excel.Worksheet, ByVal pctProgress As ProgressCtl.ProgressContro)
        Const lngColSiteID_c As Long = 2&
        Const lngColSiteIDSecondary_c As Long = 1&
        Const lngOffset_c As Long = 1&
        Dim breaksMoved As Boolean
        Dim lngRowBtm As Long
        Dim lngRow As Long
        Dim p As Excel.HPageBreak
        Dim i As Integer
        Dim passes As Long
        Dim lngHBrksUprBnd As Long
        LockInterface True
        ' Marks that no rows/columns are to be repeated on each page
        wstWorksheet.Activate
        wstWorksheet.PageSetup.PrintTitleRows = vbNullString
        wstWorksheet.PageSetup.PrintTitleColumns = vbNullString


        'If this isn't performed beforehand, then the HPageBreaks object isn't available
        '***Not true:)***

        'ActiveWindow.View = xlPageBreakPreview

        'Defaults the print area to be the entire sheet
        wstWorksheet.DisplayPageBreaks = False
        wstWorksheet.PageSetup.PrintArea = vbNullString

        ' add breaks after each site
        lngRowBtm = wstWorksheet.UsedRange.Rows.Count
        For lngRow = 4& To lngRowBtm
            'LCase is to make comparison case insensitive.
            If LCase$(wstWorksheet.Cells(lngRow, lngColSiteID_c).value) = "site id" Then
                wstWorksheet.Cells(lngRow, lngColSiteID_c).PageBreak = xlPageBreakManual
            End If
            pctProgress.ProgressText = ("Row " & CStr(lngRow)) & (" of " & CStr(lngRowBtm))
        Next

        lngHBrksUprBnd = wstWorksheet.HPageBreaks.Count - lngOffset_c
        Do  'Using post test.
            passes = passes + lngOffset_c
            breaksMoved = False
            For i = 1 To lngHBrksUprBnd
                Set p = wstWorksheet.HPageBreaks.Item(i)
                'Move the intended break point up to the first blank section
                lngRow = p.Location.Row - lngOffset_c
                For lngRow = p.Location.Row - lngOffset_c To 1& Step -1&
                    'Checking the LenB is faster than a string check.
                    If LenB(wstWorksheet.Cells(lngRow, lngColSiteIDSecondary_c).Formula) = 0& Then
                        lngRow = lngRow - lngOffset_c
                        If LCase$(wstWorksheet.Cells(lngRow, lngColSiteIDSecondary_c).value) = "site id" Then
                            breaksMoved = True
                            wstWorksheet.HPageBreaks.Add wstWorksheet.Cells(lngRow, lngColSiteIDSecondary_c)
                        End If
                        Exit For
                    End If
                Next
                pctProgress.ProgressText = "Set break point " & (CStr(passes) & "." & CStr(i))
            Next
        Loop While breaksMoved
        LockInterface False
    End Sub

    Private Sub LockInterface(ByVal interfaceOff As Boolean)
        With Excel.Application
            If interfaceOff Then
                .ScreenUpdating = False
                .EnableEvents = False
                .Cursor = xlWait
                .StatusBar = "Working..."
            Else
                .ScreenUpdating = True
                .EnableEvents = True
                .Cursor = xlDefault
                .StatusBar = False
            End If
        End With
    End Sub

这篇关于通过VBA打开Excel页面的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！