单元格更改为工作簿中的每个工作表时,VBA Excel页面中断

时间:2021-07-15 20:21:50

I have some code to add a page break at a change in cell contents, however I am unable to get it to run for more than the active sheet. I have about 80 sheets I need to run this on and need it to run at the same time. I have tried running it on ThisWorkbook, but it doesn't work. It will work great on a sheet by sheet basis, but not on the entire workbook.

我有一些代码在单元格内容的更改中添加分页符,但是我无法使其运行超过活动工作表。我有大约80张纸,我需要运行它,并需要它同时运行。我试过在ThisWorkbook上运行它,但它不起作用。它将在逐页的基础上运行良好,但不会在整个工作簿上运行。

Option Explicit

Sub Set_PageBreaks()

    Dim lastrow As Long, c As Range

    lastrow = Cells(Rows.Count, "B").End(xlUp).Row

    Application.ScreenUpdating = False

    For Each c In Range("A2:A" & lastrow)
        If c.Offset(1, 0).Value <> c.Value And c.Offset(1, 0) <> "" Then
            c.Offset(1, 0).PageBreak = xlPageBreakManual
        End If
    Next c

    Application.ScreenUpdating = True

End Sub

2 个解决方案

#1


0  

A little bit of a sloppy solution (because you shouldn't really use activate), but this should work:

一点点草率的解决方案(因为你不应该真的使用激活),但这应该工作:

Option Explicit
Sub Set_PageBreaks()

Application.ScreenUpdating = False

Dim ws_count As Long, i as long, lastrow As Long, c As Range
ws_count = ThisWorkbook.Worksheets.Count

For i = 1 to ws_count

    ThisWorkbook.Sheets(i).Activate

    lastrow = Cells(Rows.Count, "B").End(xlUp).Row

    For Each c In Range("A2:A" & lastrow)
        If c.Offset(1, 0).Value <> c.Value And c.Offset(1, 0) <> "" Then
            c.Offset(1, 0).PageBreak = xlPageBreakManual
        End If
    Next c

Next i

Application.ScreenUpdating = True
End Sub

#2


0  

Here is how I would handle your issue:

以下是我处理您的问题的方法:

Option Explicit

Sub Set_PageBreaks()

    Dim Sheet As Worksheet, C As Range, lastrow As Long

    Call SpeedUpCode(True)

    For Each Sheet In ThisWorkbook.Sheets
        lastrow = Cells(Rows.Count, "B").End(xlUp).Row
        For Each C In Range("A2:A" & lastrow)
            If C.Offset(1, 0).Value <> C.Value And C.Offset(1, 0) <> "" Then
                C.Offset(1, 0).PageBreak = xlPageBreakManual
            End If
        Next C
    Next Sheet

    Call SpeedUpCode(False)

End Sub

Sub SpeedUpCode(ByVal Value As Boolean)
    With Application
        If Value = True Then
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
        ElseIf Value = False Then
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End If
    End With
End Sub

#1


0  

A little bit of a sloppy solution (because you shouldn't really use activate), but this should work:

一点点草率的解决方案(因为你不应该真的使用激活),但这应该工作:

Option Explicit
Sub Set_PageBreaks()

Application.ScreenUpdating = False

Dim ws_count As Long, i as long, lastrow As Long, c As Range
ws_count = ThisWorkbook.Worksheets.Count

For i = 1 to ws_count

    ThisWorkbook.Sheets(i).Activate

    lastrow = Cells(Rows.Count, "B").End(xlUp).Row

    For Each c In Range("A2:A" & lastrow)
        If c.Offset(1, 0).Value <> c.Value And c.Offset(1, 0) <> "" Then
            c.Offset(1, 0).PageBreak = xlPageBreakManual
        End If
    Next c

Next i

Application.ScreenUpdating = True
End Sub

#2


0  

Here is how I would handle your issue:

以下是我处理您的问题的方法:

Option Explicit

Sub Set_PageBreaks()

    Dim Sheet As Worksheet, C As Range, lastrow As Long

    Call SpeedUpCode(True)

    For Each Sheet In ThisWorkbook.Sheets
        lastrow = Cells(Rows.Count, "B").End(xlUp).Row
        For Each C In Range("A2:A" & lastrow)
            If C.Offset(1, 0).Value <> C.Value And C.Offset(1, 0) <> "" Then
                C.Offset(1, 0).PageBreak = xlPageBreakManual
            End If
        Next C
    Next Sheet

    Call SpeedUpCode(False)

End Sub

Sub SpeedUpCode(ByVal Value As Boolean)
    With Application
        If Value = True Then
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
        ElseIf Value = False Then
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End If
    End With
End Sub