Excel,VBA and Page Breaks 2

[Databaseguy]

I have routine that creates a spreadsheet with multiple tabs in Excel from an Access Database. Within the individual tabs there are groupings of data which I want to keep together. All is well and good except for where the page breaks go. I have a counter, and insert a page break when the counter reaches a certain value, but Excel is still inserting the default page breaks. Any ideas ??

If RowCounter > 790 Then
objExcel.Range(objExcel.Cells(X - 4, 1), objExcel.Cells(X - 4, rst.Fields.Count - 2)).Select
With objExcel.Selection
objExcel.ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End With
RowCounter = 0
Else
End If

 

[DaleWatson123321]

Hi Databaseguy,

I suspect the problem is related to two areas: 1) Font Size for the Sheet, and 2) Page Setup settings - i.e. Legal Size Page, and Top/Bottom Margins.

Let me first confirm that in your question, your reference to "If RowCounter > 790 Then" should actually be 79.

In setting the Page Size to Legal, and Top/Bottom Margins to Zero, and the Sheet Font Size to 8 point, Excel's "default" page size becomes 84 rows. With a .5 Top Margin, the page size becomes 82 rows.

Unless you FIRST create the above settings, either manually or by code, Excel's default page breaks will always be less than your required length of 79, and will therefore take precedence over your VBA-generated page-breaks.

The following VBA code is what I created to place page breaks after every 79th row.

Dim objExcel As Range
Dim RowCounter As Double

Sub Insert_PageBreaks()
Application.ScreenUpdating = False
Range("top&quot.Select
Count_Row
End Sub

Sub Count_Row()
CurrentCell = ActiveCell.Value
If CurrentCell = "" Then
Application.ScreenUpdating = True
ActiveCell.Offset(1, 0).Select
End
End If
RowCounter = RowCounter + 1
ActiveCell.Offset(1, 0).Select
If RowCounter > 78 Then Insert_Break
Count_Row
End Sub

Sub Insert_Break()
ActiveCell.Select
With Selection
.PageBreak = xlPageBreakManual
End With
RowCounter = 0
End Sub

Note: As I'm relatively new to VBA, please excuse any improper layout, etc. you might find.

I hope this has been helpful.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[DaleWatson123321]

Hi Databaseguy,

...checking to see if you received my response, and whether it was helpful ???

...Dale Watson dwatson@bsi.gov.mb.ca

 

[Databaseguy]

Very Cool.Dale has done a great job.

For everyone else out there, the file is rather large (650K) and the fix was very specific. I've posted the code to satisfy everyone, although unless you know exactly what we were trying to do, it might not have much value.

Dim empno As Variant
Dim startcell As String
Dim endcell As String
Dim startrow As String
Dim endrow As String
Dim num_emps As Double
Dim emplist As String
Dim cnt As Variant
Dim rows_delete As String
Dim curcell As String
Dim cntnum As String
Dim sheet_mo As String


Sub App_Start()      ' start of process - extracting data from "data" sheet
                     ' to "Master_Month" sheet.
    Application.ScreenUpdating = False
    Initialization
    Create_Employee_List   ' creates list of employee numbers
    Delete_Existing_Data   ' deletes existing data
    Generate_Master_Month  ' extracts data for month specified by user on
                           ' "Introduction" sheet
    'Copy_To_Month          ' copies data to month sheet
        'NOTE:  Copy_To_Month is commented out, but DOES work.
        'The "de-activation" is for the following reason:
        
        'When the data is extracted to "Master_Month" sheet, the code
        'inserts page-breaks after every 3rd employee.  Therefore, when printing,
        'the layout is precise - i.e. no splitting of employee data over 2 pages.
        'However, when the data is copied to the month sheet (with Copy_to_Month),
        'the page-breaks do NOT get copied.  Therefore, they would have to be
        'inserted manually after every 3rd employee, or additional code written
        'to do so.
        
        'Because the generation of monthly data is so "quick and easy", it invites
        'the option to eliminate the process of copying monthly data to its own
        'sheet.  Instead, simply have the user generate whatever month is required
        'by entering the month in the "Introduction" sheet, and clicking the
        'button.  The page-break issue would then be resolved.
        
        'In the event that any 3 employees might have more records than will fit
        'on one page, there is always the option to "tighten up" the "Master_Month"
        'page - by eliminating the line between each employee's bottom record and
        'the totals, and reducing the lines between employees.
        
    
    Application.ScreenUpdating = True
    Range("a1").Select
End Sub

Sub Initialization()
    cnt = 0
    empno = 0
End Sub

Sub Create_Employee_List()  'extracts employee numbers from "data" sheet, for list
    Extract_Employees
    Employee_List
    Convert_Employee_List
    Sort_Employee_List
End Sub

Sub Extract_Employees()    ' subroutine from above - extracts UNIQUE numbers
    Range("data").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:="year_crit", _
    CopyToRange:=Range("emp_out"), _
    Unique:=True
End Sub

Sub Employee_List()    ' subroutine from above - creates Range Name "Emp_List"
    Worksheets("Employee_List").Select
    Range("emp_out").Select
    ActiveCell.Offset(1, 0).Select
    startcell = ActiveCell.Address
    startrow = ActiveCell.Row
    num_emps = Range("num_emp").Value - 1
    ActiveCell.Offset(num_emps, 0).Select
    endcell = ActiveCell.Address
    endrow = ActiveCell.Row
    emplist = startcell & ":" & endcell
    Range(emplist).Name = "Emp_List"
End Sub

Sub Convert_Employee_List()  ' subroutine from above - converts labels to numbers
    Range("emp_out").Select
    ActiveCell.Offset(1, 0).Select
    
    For i = startrow To endrow
        ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1
        ActiveCell.Offset(1, 0).Select
    Next

End Sub

Sub Sort_Employee_List()   ' subroutine from above - sorts employee numbers
    Range("Emp_List").Select
    Selection.Sort Key1:=ActiveCell, _
        Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
End Sub

Sub Delete_Existing_Data()  'deletes existing rows in "Master_Month" sheet
    Worksheets("Master_Month").Select
    Range("A6").Select
    startrow = ActiveCell.Row
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.Offset(1, 0).Select
    endrow = ActiveCell.Row
    rows_delete = startrow & ":" & endrow
    Rows(rows_delete).EntireRow.Select
    Selection.Delete Shift:=xlUp
End Sub

Sub Generate_Master_Month()   ' process for including all employees
                              ' in the extraction process
    Do Until cnt = num_emps + 1
        Worksheets("Employee_List").Range("emp_cnt").Value = cnt
        cnt = cnt + 1
        empno = Application.WorksheetFunction _
            .Index(Worksheets("Employee_List").Range("Emp_List"), cnt, 1)
        Clear_Formatting
        Extract_Copy_Tech_Data 'extracts employee data to "Master_Month" sheet
    Loop
End Sub

Sub Clear_Formatting()     'clears all existing formatting - lines above totals
    Worksheets("Extraction").Select
    Range("ext_format").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End Sub

Sub Extract_Copy_Tech_Data()   'extracts all employee data to "Master_Month" sheet
    Worksheets("Extraction").Select
    Range("data").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:="emp_crit", _
        CopyToRange:=Range("output"), _
        Unique:=False
    Range("emp_num").Value = empno
    Range("tech_num").Value = "Tech_Num " & Range("emp_num").Value _
        & "                " & Range("mth").Value
    Copy_Totals
    Worksheets("Master_Month").Select
    Go_Next_Row
    Insert_Break
    Worksheets("Extraction").Range("ext_data").Copy
    ActiveSheet.Paste
End Sub

Sub Copy_Totals()    ' copies totals from top of sheet to below employee records
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.Offset(10, 0).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(2, 0).Select
    curcell = ActiveCell.Address
    Worksheets("Extraction").Range("ttls").Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
End Sub

Sub Go_Next_Row()    ' finds next available row
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.Offset(10, 0).Select
    Selection.End(xlToLeft).Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(5, 0).Select
    curcell = ActiveCell.Address
End Sub

Sub Insert_Break()    ' inserts page-breaks after every 3rd employee
    If Worksheets("Employee_List").Range("emp_cnt").Value = 0 Then Exit Sub
    cntnum = Worksheets("Employee_List").Range("emp3").Value
    If cntnum = 0 Then
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
    End If
End Sub

Sub Copy_To_Month()  'copies "Master_Month" data to month sheet
    sheet_mo = Worksheets("Employee_List").Range("mo_name").Value
    Sheets("Master_Month").Select
    Cells.Select
    Selection.Copy
    Sheets(sheet_mo).Select
    Cells.Select
    ActiveSheet.Paste
End Sub

Tyrone Lumley
augerinn@gte.net

http://server47.hypermart.net/databaseguy