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,164
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
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,112
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
An intersting read here, that might head you in the right direction....I haven't found anything else that will do what you ask
Also, what about an Inputbox that asks the user to insert a pageBreak at row n , then does it ??
 
Last edited:

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,710
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
In this thread you said you had it working.
 

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,164
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Oct 27, 2005
Messages
20,112
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

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

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,164
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Well, thanks again for trying ;)
 

Michael M

Well-known Member
Joined
Oct 27, 2005
Messages
20,112
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Aug 14, 2018
Messages
2,164
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Oct 27, 2005
Messages
20,112
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
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)
VBA Code:
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

Well-known Member
Joined
Oct 27, 2005
Messages
20,112
Office Version
  1. 2016
  2. 2013
  3. 2007
Platform
  1. Windows
Improved code...
VBA 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
 

Watch MrExcel Video

Forum statistics

Threads
1,129,373
Messages
5,635,884
Members
416,886
Latest member
coreyalaurence37

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
Top