Excel page breaks via VBA

前端 未结 3 564
囚心锁ツ
囚心锁ツ 2020-12-19 23:35

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 brea

3条回答
  •  醉梦人生
    2020-12-20 00:10

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

    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.

    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
    

提交回复
热议问题