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]

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

 

[dpaton05]

This is my code to insert the correct signature. How do I incorporate your code into it?

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.

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

 

[Michael M]

Why don't you just call it at the end ??
It won't do anything if there is no overlap !

 

[dpaton05]

That doesn't make a difference

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

 

[Michael M]

So what is happening when you step through the code ??

 

[dpaton05]

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.

 

[Michael M]

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

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

 

[dpaton05]

Thank you Michael, that is perfect!!

Love the work that you do helping people on this forum!!

 

[Michael M]

Whew !!
Glad we managed to get that one sorted....I'm sure there is a better way, but it works..

 

[dpaton05]

Ok, now I will not touch that bit.

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

Thanks again.