Pushing an image to the following page if it is split over the page break

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,352
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I have a spreadsheet that has a table that can have x number of rows. At the bottom of the spreadsheet, I have multiple buttons to place one of 4 people's signatures.


If the number of rows added causes the signatures to be inserted over the page break, half of a signature will be inserted on one page and half will be inserted of the following page. How do I push it to the following page if it is over the page break?

This is the code behind the buttons
VBA Code:
        Sub cmdTraceySig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgT"
Call cmdNoSig
Call cmdPush(user)
Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdLynSig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgL"
Call cmdNoSig
Call cmdPush(user)
'Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdGarrettSig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgG"
Call cmdNoSig
Call cmdPush(user)
'Quoting.Protect Password:=ToUnlock
End Sub
Sub cmdJonathanSig()
Quoting.Unprotect Password:=ToUnlock
Dim user As String
user = "ImgJ"
Call cmdNoSig
Call cmdPush(user)
'Quoting.Protect Password:=ToUnlock
End Sub

Here is cmdPush and cmdNoSig
VBA Code:
        Sub cmdPush(user As String)
Dim LastRow As Long, ImageHeight As Double, LastRowBeforeLastPageBreak As Double, DividerBottomPlusSpace As Long
Dim NoPages As Long, ws As Worksheet, n As Long
Set ws = Sheets("CSS_quote_sheet")
'Finds the number of pages
n = ws.HPageBreaks.Count
NoPages = ((ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)) / 2
Application.ScreenUpdating = False
With Sheets("Sheet2")
.Shapes(user).Duplicate.Name = "Signature"
.Shapes("Signature").Cut
End With
ws.Cells(43, 1).PasteSpecial
ws.Shapes(Selection.Name).Name = "Signature"
Selection.Top = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1).Top + 140
LastRow = ws.Columns("A:H").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
ImageHeight = ws.Shapes("Signature").Height
LastRowBeforeLastPageBreak = ws.HPageBreaks(n).Location.Row - 1
DividerBottomPlusSpace = ws.Shapes("Divider").BottomRightCell.Top + 140
With ws.Shapes("Signature")
.Left = ActiveSheet.Range("A1").Left
.Top = Rows(LastRow).Top + 140
       
.Placement = 1
'End If
End With
Application.ScreenUpdating = True
End Sub
Sub cmdNoSig()
Dim Pic As Object
   
For Each Pic In Quoting.Pictures
If Pic.Name <> "lblActivities" And Pic.Name <> "TextBox3" And Pic.Name <> "lblNotes" And Pic.Name <> "cmdAdd_Nlines" And Pic.Name <> "cmdDeleteRow" And Pic.Name <> "cmdClearNotDates" And _
Pic.Name <> "cmdDelSelect" And Pic.Name <> "cmdGarrettB" And Pic.Name <> "cmdNoSignature" And Pic.Name <> "cmdSendTCT" And Pic.Name <> "cmdSort" And _
Pic.Name <> "cmdDeleteQuoteLines" And Pic.Name <> "ImgLogo" And Pic.Name <> "cmdCustom" And Pic.Name <> "chkIncrease" And Pic.Name <> "lblIncrease" And _
Pic.Name <> "cmdTraceyS" And Pic.Name <> "cmdLynL" And Pic.Name <> "cmdJonathanA" And Pic.Name <> "cmdPrintPdf" And Pic.Name <> "cmdQuoteTips" And _
Pic.Name <> "Label1" And Pic.Name <> "cmdSendTCTPrint" And Pic.Name <> "textbox4" And Pic.Name <> "lblNotes" And Pic.Name <> "CmdSpacer" And Pic.Name <> "cmdUnlock" Then
' If Not Intersect(Pic.TopLeftCell, Range("A12:A300")) Is Nothing Then
Pic.Delete
'End If
End If
Next Pic
End Sub

Thanks
 
Thanks Michael, I will get to it, just got a something to deal with first
 
Upvote 0

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
This is my code to insert the correct signature. How do I incorporate your code into it?

VBA Code:
Sub cmdPush(user As String)
Dim LastRow As Long, ImageHeight As Double, LastRowBeforeLastPageBreak As Double, DividerBottomPlusSpace As Long
Dim NoPages As Long, ws As Worksheet, n As Long
Set ws = Sheets("CSS_quote_sheet")
'Finds the number of pages
n = ws.HPageBreaks.Count
NoPages = ((ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)) / 2
Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        ws.Cells(43, 1).PasteSpecial
        ws.Shapes(Selection.Name).Name = "Signature"
        Selection.Top = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1).Top + 140
        LastRow = ws.Columns("A:H").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        ImageHeight = ws.Shapes("Signature").Height
        'LastRowBeforeLastPageBreak = ws.HPageBreaks(n).Location.Row - 1
        DividerBottomPlusSpace = ws.Shapes("Divider").BottomRightCell.Top + 140
    With ws.Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = Rows(LastRow).Top + 140
        .Placement = 1
        'End If
    End With
Application.ScreenUpdating = True
End Sub


I tried to add it to the end of my current code but that didn't seem to work.
VBA Code:
Sub cmdPush(user As String)
Dim LastRow As Long, ImageHeight As Double, LastRowBeforeLastPageBreak As Double, DividerBottomPlusSpace As Long
Dim NoPages As Long, ws As Worksheet, n As Long
Set ws = Sheets("CSS_quote_sheet")
'Finds the number of pages
n = ws.HPageBreaks.Count
NoPages = ((ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)) / 2
Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        ws.Cells(43, 1).PasteSpecial
        ws.Shapes(Selection.Name).Name = "Signature"
        Selection.Top = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1).Top + 140
        LastRow = ws.Columns("A:H").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        ImageHeight = ws.Shapes("Signature").Height
        'LastRowBeforeLastPageBreak = ws.HPageBreaks(n).Location.Row - 1
        DividerBottomPlusSpace = ws.Shapes("Divider").BottomRightCell.Top + 140
    With ws.Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = Rows(LastRow).Top + 140
        .Placement = 1
        'End If
    End With
Dim hPB As HPageBreak, lRow As Long
    For Each hPB In ActiveSheet.HPageBreaks
    lRow = hPB.Location.Row
        With ActiveSheet.Shapes("Signature")
            If lRow - .TopLeftCell.Row <= 2 Then .Top = Range("A" & lRow + 6).Top
    End With
        Next hPB
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Why don't you just call it at the end ??
It won't do anything if there is no overlap !
 
Upvote 0
That doesn't make a difference

VBA Code:
Sub cmdPush(user As String)
Dim LastRow As Long, ImageHeight As Double, LastRowBeforeLastPageBreak As Double, DividerBottomPlusSpace As Long
Dim NoPages As Long, ws As Worksheet, n As Long
Set ws = Sheets("CSS_quote_sheet")
'Finds the number of pages
n = ws.HPageBreaks.Count
NoPages = ((ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)) / 2
Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Shapes(user).Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        ws.Cells(43, 1).PasteSpecial
        ws.Shapes(Selection.Name).Name = "Signature"
        Selection.Top = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1).Top + 140
        LastRow = ws.Columns("A:H").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
        ImageHeight = ws.Shapes("Signature").Height
        'LastRowBeforeLastPageBreak = ws.HPageBreaks(n).Location.Row - 1
        DividerBottomPlusSpace = ws.Shapes("Divider").BottomRightCell.Top + 140
    With ws.Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = Rows(LastRow).Top + 140
        .Placement = 1
        'End If
    End With
Call pushover
End Sub

Sub pushover()
Dim hPB As HPageBreak, lRow As Long
    For Each hPB In ActiveSheet.HPageBreaks
    lRow = hPB.Location.Row
        With ActiveSheet.Shapes("Signature")
            If lRow - .TopLeftCell.Row <= 2 Then .Top = Range("A" & lRow + 6).Top
    End With
        Next hPB
Application.ScreenUpdating = True
End Sub
 
Upvote 0
So what is happening when you step through the code ??
 
Upvote 0
I step through it and

  1. the signature is placed at row 43
  2. it is moved to 140 below the last cell in column A
    1. I do not think I even need this line as the signature is moved again after it
    2. Selection.Top = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1).Top + 140
  3. The last row with any data in it is found, in my case, it is row 27
  4. I keep stepping through it and at the end of the with block, the signature is moved to the 140 below row 27, which causes the signature to be split between 2 pages
  5. I keep stepping through the sub called pushover and nothing happens.
 
Last edited:
Upvote 0
The reason nothing happens is that the code sees the shape as meeting to criteria not to move
You will have to modify your TopLeft Line to suit the shape size
Change the first one to between 2 and 10 and the second one also between 2 and 10
I have tried using 5 and 2 which seem OK

Rich (BB code):
Sub pushover()
Dim hPB As HPageBreak, lRow As Long
    For Each hPB In ActiveSheet.HPageBreaks
    lRow = hPB.Location.Row
    ActiveSheet.Shapes("Signature").Select
        With ActiveSheet.Shapes("Signature")
            If lRow - .TopLeftCell.Row <= 5 Then .Top = Range("A" & lRow + 2).Top
    End With
        Next hPB
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you Michael, that is perfect!!

Love the work that you do helping people on this forum!!
 
Upvote 0
Whew !!
Glad we managed to get that one sorted....I'm sure there is a better way, but it works.. :cool: (y)
 
Upvote 0
Ok, now I will not touch that bit.

It ain't broke, so I won't fix it. ;)

Thanks again.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

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