Ensure text box alway remains between page break

Paulo H

Board Regular
Joined
Jun 10, 2020
Messages
106
Office Version
  1. 2016
Platform
  1. Windows
Hi I have a sheet with a table which is populated via a list box and works well. When the data from the list box is transfers to the table the table auto expands and adds row as expected. Below this I have a textbox with term and conditions in and when the table expands the list box moves down the sheet fine. However when it reaches a page break, the break cut across the text box and splits over two pages. What I require is all of the textbox to be all on one page. I have set in a row and set the properties to move and size and this works if I insert Via right click etc but not when table expand via list box entry. It moves down the table then to the next row leaving the original cell row too big and not resizing new row. Cheers
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
This code will move a TextBox that is on a Horizontal Page Break so its top is at the Horizontal Page Break

VBA Code:
Option Explicit

Sub MoveTextboxOnPageBreak()

    Dim aryBreaks As Variant
    Const sTextBoxName As String = "Textbox 2"
    Dim lTopLeftRow As Long
    Dim lBottomRightRow As Long
    Dim lIndex As Long
    Dim lHBCount As Long
    Dim lHBRow As Long
    
    Dim x
    
    With ActiveSheet
        Set x = .Shapes("TEXTBOX 2")
        .DisplayPageBreaks = True
        aryBreaks = GetHorizPageBreaks
        lHBCount = UBound(aryBreaks)
        If lHBCount > 1 Then
            'Might have to move box
            lTopLeftRow = .Shapes("Textbox 2").TopLeftCell.Row
            lBottomRightRow = .Shapes("Textbox 2").BottomRightCell.Row
            For lIndex = 2 To lHBCount
                lHBRow = aryBreaks(lIndex)
                If lTopLeftRow < lHBRow And lBottomRightRow + 1 > lHBRow Then
                    'Horizontal Break is between top and bottom of textbox
                    .Shapes("Textbox 2").Top = .Cells(lHBRow, 1).Top
                    Exit For
                End If
            Next
        Else
            'No horizontal break yet
        End If
    End With

End Sub

Function GetHorizPageBreaks()
    'Return existing horizontal page breaks on the active sheet
    
    Dim HPBrk As HPageBreak
    Dim sType As String
    Dim aryHBreaks As Variant
    Dim lIndex As Long
    'Note Automatic page breaks do not exist unless there is text that reqires them
    
    With ActiveSheet
        If .HPageBreaks.Count > 0 Then
            ReDim aryHBreaks(1 To .HPageBreaks.Count + 1)
            aryHBreaks(1) = 1
            lIndex = 1
            For Each HPBrk In .HPageBreaks
                lIndex = lIndex + 1
                'First row on new page
                aryHBreaks(lIndex) = HPBrk.Location.Row
            Next
        Else
            ReDim aryHBreaks(1 To 1)
            aryHBreaks(1) = 1
        End If
    End With
    
    GetHorizPageBreaks = aryHBreaks

End Function
 
Upvote 0
This code will move a TextBox that is on a Horizontal Page Break so its top is at the Horizontal Page Break

VBA Code:
Option Explicit

Sub MoveTextboxOnPageBreak()

    Dim aryBreaks As Variant
    Const sTextBoxName As String = "Textbox 2"
    Dim lTopLeftRow As Long
    Dim lBottomRightRow As Long
    Dim lIndex As Long
    Dim lHBCount As Long
    Dim lHBRow As Long
   
    Dim x
   
    With ActiveSheet
        Set x = .Shapes("TEXTBOX 2")
        .DisplayPageBreaks = True
        aryBreaks = GetHorizPageBreaks
        lHBCount = UBound(aryBreaks)
        If lHBCount > 1 Then
            'Might have to move box
            lTopLeftRow = .Shapes("Textbox 2").TopLeftCell.Row
            lBottomRightRow = .Shapes("Textbox 2").BottomRightCell.Row
            For lIndex = 2 To lHBCount
                lHBRow = aryBreaks(lIndex)
                If lTopLeftRow < lHBRow And lBottomRightRow + 1 > lHBRow Then
                    'Horizontal Break is between top and bottom of textbox
                    .Shapes("Textbox 2").Top = .Cells(lHBRow, 1).Top
                    Exit For
                End If
            Next
        Else
            'No horizontal break yet
        End If
    End With

End Sub

Function GetHorizPageBreaks()
    'Return existing horizontal page breaks on the active sheet
   
    Dim HPBrk As HPageBreak
    Dim sType As String
    Dim aryHBreaks As Variant
    Dim lIndex As Long
    'Note Automatic page breaks do not exist unless there is text that reqires them
   
    With ActiveSheet
        If .HPageBreaks.Count > 0 Then
            ReDim aryHBreaks(1 To .HPageBreaks.Count + 1)
            aryHBreaks(1) = 1
            lIndex = 1
            For Each HPBrk In .HPageBreaks
                lIndex = lIndex + 1
                'First row on new page
                aryHBreaks(lIndex) = HPBrk.Location.Row
            Next
        Else
            ReDim aryHBreaks(1 To 1)
            aryHBreaks(1) = 1
        End If
    End With
   
    GetHorizPageBreaks = aryHBreaks

End Function
Thanks for this but not sure if I am setting it wrong I am adding it to the main worksheet but the text box which has the info in still straddles the page break when items are inserted into my table
 
Upvote 0
My original code was for Excel 2010. It worked in that version. It failed when I tried to run it in Excel 2016.
I added a version checker that used that code for versions less that Excel 2016 and a different code for Excel 2016 and later. I therefore assumed that Excel 2013 would be happy with the 2020 version. This may not be the case.

I also used the sTextBoxName constant properly instead of having the hard coded name of the textbox in 5 different places.

If you are running Excel 2013 this might still error out.
Try the following code and let me know how it works and if there is a problem what version of Excel you are running.

Be sure to replace Textbox 2 in the following line in 'Sub MoveTextboxOnPageBreak' to the name of the Textbox you are using.

Const sTextBoxName As String = "Textbox 2" 'Change Textbox 2 to the name of the textbox that you want to keep off of the page break

VBA Code:
Option Explicit

Sub MoveTextboxOnPageBreak()

    Dim aryBreaks As Variant
    Const sTextBoxName As String = "Textbox 2"  'Change Textbox 2 to the name of the textbox that you want to keep off of the page break
    Dim lTopLeftRow As Long
    Dim lBottomRightRow As Long
    Dim lIndex As Long
    Dim lHBCount As Long
    Dim lHBRow As Long
    
    Dim x
    
    With ActiveSheet
        Set x = .Shapes(sTextBoxName)
        .DisplayPageBreaks = True
        aryBreaks = GetHorizPageBreaks
        lHBCount = UBound(aryBreaks)
        If lHBCount > 1 Then
            'Might have to move box
            lTopLeftRow = .Shapes(sTextBoxName).TopLeftCell.Row
            lBottomRightRow = .Shapes(sTextBoxName).BottomRightCell.Row
            For lIndex = 2 To lHBCount
                lHBRow = aryBreaks(lIndex)
                If lTopLeftRow < lHBRow And lBottomRightRow + 1 > lHBRow Then
                    'Horizontal Break is between top and bottom of textbox
                    .Shapes(sTextBoxName).Top = .Cells(lHBRow, 1).Top
                    Exit For
                End If
            Next
        Else
            'No horizontal break yet
        End If
    End With

End Sub

Function GetHorizPageBreaks()
    'Return existing horizontal page breaks on the active sheet
    
    Dim HPBrk As HPageBreak
    Dim sType As String
    Dim aryHBreaks As Variant
    Dim lIndex As Long
    'Note Automatic page breaks do not exist unless there is text that requires them
    
    With ActiveSheet
        If .HPageBreaks.Count > 0 Then
            ReDim aryHBreaks(1 To .HPageBreaks.Count + 1)
            aryHBreaks(1) = 1
             If Val(Application.Version) < 16 Then
                'Excel 2010
                For Each HPBrk In .HPageBreaks
                    lIndex = lIndex + 1
                    'First row on new page
                    aryHBreaks(lIndex) = HPBrk.Location.Row
                Next
            Else
                'Excel 2016
                For lIndex = 2 To UBound(aryHBreaks)
                    aryHBreaks(lIndex) = .HPageBreaks(lIndex - 1).Location.Row
                Next
            End If
        Else
            ReDim aryHBreaks(1 To 1)
            aryHBreaks(1) = 1
        End If
    End With
    
    GetHorizPageBreaks = aryHBreaks

End Function
 
Upvote 0
My original code was for Excel 2010. It worked in that version. It failed when I tried to run it in Excel 2016.
I added a version checker that used that code for versions less that Excel 2016 and a different code for Excel 2016 and later. I therefore assumed that Excel 2013 would be happy with the 2020 version. This may not be the case.

I also used the sTextBoxName constant properly instead of having the hard coded name of the textbox in 5 different places.

If you are running Excel 2013 this might still error out.
Try the following code and let me know how it works and if there is a problem what version of Excel you are running.

Be sure to replace Textbox 2 in the following line in 'Sub MoveTextboxOnPageBreak' to the name of the Textbox you are using.

Const sTextBoxName As String = "Textbox 2" 'Change Textbox 2 to the name of the textbox that you want to keep off of the page break

VBA Code:
Option Explicit

Sub MoveTextboxOnPageBreak()

    Dim aryBreaks As Variant
    Const sTextBoxName As String = "Textbox 2"  'Change Textbox 2 to the name of the textbox that you want to keep off of the page break
    Dim lTopLeftRow As Long
    Dim lBottomRightRow As Long
    Dim lIndex As Long
    Dim lHBCount As Long
    Dim lHBRow As Long
   
    Dim x
   
    With ActiveSheet
        Set x = .Shapes(sTextBoxName)
        .DisplayPageBreaks = True
        aryBreaks = GetHorizPageBreaks
        lHBCount = UBound(aryBreaks)
        If lHBCount > 1 Then
            'Might have to move box
            lTopLeftRow = .Shapes(sTextBoxName).TopLeftCell.Row
            lBottomRightRow = .Shapes(sTextBoxName).BottomRightCell.Row
            For lIndex = 2 To lHBCount
                lHBRow = aryBreaks(lIndex)
                If lTopLeftRow < lHBRow And lBottomRightRow + 1 > lHBRow Then
                    'Horizontal Break is between top and bottom of textbox
                    .Shapes(sTextBoxName).Top = .Cells(lHBRow, 1).Top
                    Exit For
                End If
            Next
        Else
            'No horizontal break yet
        End If
    End With

End Sub

Function GetHorizPageBreaks()
    'Return existing horizontal page breaks on the active sheet
   
    Dim HPBrk As HPageBreak
    Dim sType As String
    Dim aryHBreaks As Variant
    Dim lIndex As Long
    'Note Automatic page breaks do not exist unless there is text that requires them
   
    With ActiveSheet
        If .HPageBreaks.Count > 0 Then
            ReDim aryHBreaks(1 To .HPageBreaks.Count + 1)
            aryHBreaks(1) = 1
             If Val(Application.Version) < 16 Then
                'Excel 2010
                For Each HPBrk In .HPageBreaks
                    lIndex = lIndex + 1
                    'First row on new page
                    aryHBreaks(lIndex) = HPBrk.Location.Row
                Next
            Else
                'Excel 2016
                For lIndex = 2 To UBound(aryHBreaks)
                    aryHBreaks(lIndex) = .HPageBreaks(lIndex - 1).Location.Row
                Next
            End If
        Else
            ReDim aryHBreaks(1 To 1)
            aryHBreaks(1) = 1
        End If
    End With
   
    GetHorizPageBreaks = aryHBreaks

End Function
H thanks again for your help

It still doesn't appear to work but it may be me

I am using excel 2016. The text box was created on the main sheet using excel insert then text box but this doesn't appear to give a name i.e "text box 2" the only option I have is set as default text box. Also could it have something to do with the table I have as the problem occurs when I add a row to the table. the textbox is being used to add terms and conditions to a quote and the table is the quote which of course expands when items are inserted. therefore when the final form is done and viewed the textbox is split over two pages. Not a real problem but I would prefer if it was moved to separate page. Thanks again
 
Upvote 0
Butting in briefly ....

It still doesn't appear to work but it may be me
Yes ;)

Right click on the text box to select it
Name appears in the Name Box
Name Box is the box above cell A1

This may also help
- code below lists names of shapes in active sheet
VBA Code:
Sub LoopShapes()
    Dim shp As Shape, msg As String
    For Each shp In ActiveSheet.Shapes
        msg = msg & vbCr & shp.TopLeftCell.Address(0, 0) & vbTab & shp.Name
    Next
    MsgBox msg
End Sub
 
Upvote 0
Butting in briefly ....


Yes ;)

Right click on the text box to select it
Name appears in the Name Box
Name Box is the box above cell A1

This may also help
- code below lists names of shapes in active sheet
VBA Code:
Sub LoopShapes()
    Dim shp As Shape, msg As String
    For Each shp In ActiveSheet.Shapes
        msg = msg & vbCr & shp.TopLeftCell.Address(0, 0) & vbTab & shp.Name
    Next
    MsgBox msg
End Sub
Hi that was very helpfulit is textbox 2!
 
Upvote 0
H thanks again for your help

It still doesn't appear to work but it may be me

I am using excel 2016. The text box was created on the main sheet using excel insert then text box but this doesn't appear to give a name i.e "text box 2" the only option I have is set as default text box. Also could it have something to do with the table I have as the problem occurs when I add a row to the table. the textbox is being used to add terms and conditions to a quote and the table is the quote which of course expands when items are inserted. therefore when the final form is done and viewed the textbox is split over two pages. Not a real problem but I would prefer if it was moved to separate page. Thanks again
Btw it is text box 2. I pressume I shout be adding this to the main worksheet?
 
Upvote 0
Find the name of the textbox that is on your worksheet using the method that Yongle described

Right click on the text box to select it
Name appears in the Name Box
Name Box is the box above cell A1

then in my code from post #5 (which is copied to the code page of the worksheet that contains the textbox) replace Textbox 2 in this line:

Const sTextBoxName As String = "Textbox 2"

with the name of your textbox.

The code will move the textbox when it is run. It will not run automatically. You could call it from a print subroutine a worksheet event or trigger it manually.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,999
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top