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

[dpaton05]

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 = .Range("A:H").Find(What:="*", _
            After:=.Range("A1"), _
            Lookat:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row
    End With
End Function
Sub cmdSig()
    Sheets("Sheet2").Shapes("ImgT").Copy
    ActiveSheet.Paste Destination:=ActiveSheet.Cells(1, 1)
    Selection.Top = Cells(LastRow, 1).Top + "100"
End Sub

 

[dpaton05]

Could you please help me with the above issue Michael?

 

[jolivanes]

Just going by your first sentence in Post #1
This is what I use. Don't know if it is of any help.

Sub Place_Pic()
Dim fNameAndPath As Variant
Dim img As Picture, a As Double, aa As Double, aaa As Double
Set img = ActiveSheet.Pictures.Insert(Selection.Value)
'Set img = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("S22").Value)    'ActiveSheet.Pictures.Insert(fNameAndPath)
a = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Top + 1
aa = img.Height
aaa = Rows(ActiveSheet.HPageBreaks(1).Location.Row).Top + 1
    With img
        .Left = ActiveSheet.Range("A1").Left
        .Top = IIf(a + aa > aaa, aaa, a)   
        .Placement = 1
        .PrintObject = True
    End With
End Sub

 

[dpaton05]

Thanks jolinaves, I tried to modify your code to work with my spreadsheet but it gives me the error subscript out of range. This is the code that I tried to write:

Sub a()

Dim fNameAndPath As Variant
Dim img As Picture, a As Double, aa As Double, aaa As Double
    Sheets("Sheet2").Shapes("ImgT").Copy
    ActiveSheet.Paste Destination:=ActiveSheet.Cells(1, 1)
    
'Set img = Worksheets("Sheet2").ListObjects("ImgL")
'Set img = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\" & Range("S22").Value)    'ActiveSheet.Pictures.Insert(fNameAndPath)
a = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1).Top + 1
aa = Selection.Height
aaa = Rows(ActiveSheet.HPageBreaks(1).Location.Row).Top + 1
    With Selection
        .Left = ActiveSheet.Range("A1").Left
        .Top = IIf(a + aa > aaa, aaa, a)
        .Placement = 1
        .PrintObject = True
    End With
End Sub

 

[dpaton05]

Function LastRow()
lr =Sheets("CSS_quote_sheet") .Range("A:H").Find("*", , xlValues, , xlRows, xlPrevious).Row
End Function

This was doesn't work, it gives me an application defined error, highlighting this line

Selection.Top = Cells(LastRow, 1).Top + "100"

Using my code to define the LastRow worked though

 

[Michael M]

Sorry in this line change lastRow to lr

Selection.Top = Cells(LastRow, 1).Top + "100"

Selection.Top = Cells(lr, 1).Top + "100"

 

[jolivanes]

Copy and Paste pictures from one sheet to another has been a hit and miss thing for me.
I have put it to the people in a forum, tried all suggestions and this is what I use if the only option is from one sheet to another sheet.
Also not foolproof but with the least errors so far.

Sheets("Sheet2").Shapes("Picture 1").Copy
Application.GoTo Sheets("Sheet1").Cells(3, 3)
ActiveSheet.Paste

There are no errors with bringing in a picture from a folder (ActiveSheet.Pictures.Insert) so that's what I use if I can.
I have a Folder with nothing but pictures used to import.

 

[jolivanes]

Had several trial runs with this and hasn't failed (yet). Does for me what you asked.
Obviously, change references where required.

Sub Place_Signature()
Dim a As Double, aa As Double, aaa As Double
Application.ScreenUpdating = False
    With Sheets("Sheet3")
        .Shapes("Picture 1").Duplicate.Name = "Signature"
        .Shapes("Signature").Cut
    End With
        Sheets("Sheet2").Cells(43, 1).PasteSpecial
        Sheets("Sheet2").Shapes(Selection.Name).Name = "Signature"
        a = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Top + 1
        aa = Sheets("Sheet2").Shapes("Signature").Height
        aaa = Rows(Sheets("Sheet2").HPageBreaks(1).Location.Row).Top + 1
    With Sheets("Sheet2").Shapes("Signature")
        .Left = ActiveSheet.Range("A1").Left
        .Top = IIf(a + aa > aaa, aaa, a)
        .Placement = 1
    End With
Application.ScreenUpdating = True
End Sub

Need to be prettied it up if it works.

 

[dpaton05]

Thanks, I will try it when I get back to work on Monday.

 

[dpaton05]

That works pretty well but it snaps the signature to the bottom of the table and then it gets pushed to the next page if it is over the page break. The only issue is that there are things under the table and I want the signature to appear under those things.

I need the signature to be 100 from the bottom of the table, this will allow room for all the extras below the table that must be in between the table and the signature. I have tried to change the code but I just can't seem to visualise and get the correct code for this to happen. How do I adjust the code so the starting point will be 100 below the table and not directly below the table and then to have it move to the next page if part of the new location is over the page break.

I hope I explained that correctly.
Thanks.

 

[jolivanes]

See what the result is if you change the 10th line to this

a = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1).Top + 100