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

[dpaton05]

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

        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

        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

 

[dpaton05]

Not sure what has happened but it has partially stopped working. The signature still is pushed below the notes the correct distance at this point

The signature is placed in the right spot until PushOver is run and then the signature is placed like this

The idea of the PushOver sub was that it only executes if the signature is placed over a page break but it appears to be executing every time. Could you help me work out why please?


If it is not placed over the page break, it still works by placing the signature a set distance below the bottom note.

For your reference, here is the code:

Sub cmdGarrettSig()
    Quoting.Unprotect Password:=ToUnlock
    Dim user As String
        user = "ImgG"
        Call cmdNoSig
        Call cmdPush(user)
    'Quoting.Protect Password:=ToUnlock
End Sub



Sub cmdPush(user As String)
Dim LastRow As Long, ImageHeight 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 = ws.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
        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 <= 5 Then .Top = Range("A" & lRow + 2).Top
    End With
        Next hPB
Application.ScreenUpdating = True
End Sub

 

[Michael M]

If the With / End with statement runs, PushOver will always be called as it is outside the statement
Have you tried exiting the sub within that with statement

With ws.Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = Rows(LastRow).Top + 140
        .Placement = 1
       Exit sub
    End With

 

[dpaton05]

Actually Michael, my boss has just told me he doesn't want this feature anymore as it is causing too much trouble. Thanks for your help though.

 

[Michael M]

Gotta love our bosses...

 

[dpaton05]

Tell me about it