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

 

[Michael M]

An intersting read here, that might head you in the right direction....I haven't found anything else that will do what you ask

Conditional Page Breaks (Microsoft Excel)

Need to have your worksheet printout start on a new page every time a value in a column changes? There are a couple of ways you can accomplish the task, as described in this tip. (Tips.Net)

excel.tips.net

Also, what about an Inputbox that asks the user to insert a pageBreak at row n , then does it ??

 

[jolivanes]

In this thread you said you had it working.

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

I have a procedure that pastes in a signature from another sheet, just below the bottom of a quote. Is there a way to push it to the next page if the signature ends up being half on one page and half on the next? Function LastRow() With Sheets("CSS_quote_sheet") LastRow =...

www.mrexcel.com

 

[dpaton05]

I said that my supervisor was happy with it but I wanted to get it working as intended.

Thanks Michael for continuing to search for an answer but I think I will have to be satisfied with how that part is working and move on to other pressing issues that he wants Changed.

 

[Michael M]

Given the amount of Googling I have done.......I'm seeing this as one for the 2 hard basket...

 

[dpaton05]

Well, thanks again for trying

 

[Michael M]

As mentioned earlier, If you know how many rows are going to fill a page, why not get the user to Insert the page break via an InputBox
1. If the page exceeds x number of rows a popup InputBox appears
2. User selects the row where they want the page to break
3. code then inserts the PageBreak

Just a thought !!

 

[dpaton05]

Thanks for that Michael. Just thought it may have been a quick fix but doesn't look like it so I will move on to other more pressing problems I am having with this tool.

 

[Michael M]

Okay, I ended up creating my own to do this......
So,
1. You will need to change the shape name to suit, assuming your sigs are shapes
2. you will need to modify the + 2 or -2 to suit your needs
3. you will need to adjust your .Top position to suit ( I used 6)

Sub MM1()
Dim hPB As HPageBreak
Dim lRow As Long
 For Each hPB In ActiveSheet.HPageBreaks
 lRow = hPB.Location.Row
 With ActiveSheet.Shapes("Rectangle 1")
 If .TopLeftCell.Row - lRow <= 2 And .TopLeftCell.Row - lRow >= -2 Then
    .Top = Range("A" & lRow + 6).Top
End If
End With
Next hPB
End Sub

 

[Michael M]

Improved code...

Sub MM1()
Dim hPB As HPageBreak, lRow As Long
 For Each hPB In ActiveSheet.HPageBreaks
    lRow = hPB.Location.Row
      With ActiveSheet.Shapes("Rectangle 1")
          If lRow - .TopLeftCell.Row <= 2 Then .Top = Range("A" & lRow + 6).Top
      End With
Next hPB
End Sub