VBA to insert a custom image

[dpaton05]

I have code to insert a set image. Could someone tell me how to alter it so it can insert a custom image please?

Sub cmdJakeSig()
    Dim shp As Shape
    Set shp = ThisWorkbook.Worksheets("sheet1").Shapes("textbox4")
        Sheets("Sheet2").Shapes("ImgJ").Copy
        Sheets("sheet1").Paste Destination:=Sheets("sheet1").Cells(1, 1)
        Selection.Top = shp.Top + shp.Height + "50"
    'ActiveSheet.Protect Password:=""
End Sub

 

[dpaton05]

My code puts the image in the right spot, doesn't take long to complete but doesn't push the image to the next page if it gets split between the two.

Sub cmdCustomSig()
Dim fNameAndPath As Variant
Dim img As Picture, shp As Shape
Set shp = ThisWorkbook.Worksheets("sheet1").Shapes("textbox4")

fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
    Set img = Worksheets("sheet1").Pictures.Insert(fNameAndPath)
    With img
       .Top = shp.Top + shp.Height + "50"
       .Left = "0"
    End With
     
End Sub

 

[Michael M]

sounds like your super doesn't want you getting any help !!
My hands are tied if I can't play with your workbook...

 

[Michael M]

Try this one then....AND it's faster

Slight mod AND ..it assumes you lr is based on Col "A"

Private Sub CommandButton1_Click()
'insert custom image code from michael
Dim fNameAndPath As Variant
Dim img As Picture, shp As Shape
Set shp = Worksheets("NPSS_quote_sheet").Shapes("TextBox4")
fNameAndPath = Application.GetOpenFilename(Title:="Select Signature To Be Imported")
If fNameAndPath = False Then Exit Sub
 Dim h As Long, lr As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row
Set img = Worksheets("NPSS_quote_sheet").Pictures.Insert(fNameAndPath)
  h = 51
    If Sheets("NPSS_quote_sheet").Rows(h).PageBreak <> xlPageBreakNone Then
    If lr >= h - 5 Then 'this is 5 rows before the page break
    With img
       .Left = 0
       .Top = h + 50 + shp.Top + shp.Height
    End With
    Else
    With img
       .Left = 0
       .Top = shp.Top + shp.Height + 50
    End With
    End If
    End If
End Sub

 

[dpaton05]

Much quicker thanks but it puts the image near the top of the page, not under the notes box on the first page.

 

[Michael M]

The longest data column is definitely Col "A" isn't it ??
AND
where is the page break, line 50 which is standard, or id it a custom page break ??

 

[dpaton05]

Here you go Michael, try this link

https://drive.google.com/open?id=1lJ6LI4hqkgdpOASofzkc05LWTIhQMUWx

Click on the G button on Sheet1, it pastes the image half on one page and half on the next. It does the same thing for the J button and custom signature button. If they are split between 2 pages, I need them pushed onto the second page.

 

[Michael M]

Ok, psrt of the problem was that the sheet didn't have any PageBreaks !
Secondly Col "A" only had one line of data, whereas Col "H" had a full set of data !
Try this way

Private Sub CommandButton1_Click()
'insert custom image code from michael
Dim fNameAndPath As Variant
Dim img As Picture, shp As Shape
Set shp = Worksheets("Sheet1").Shapes("TextBox4")
fNameAndPath = Application.GetOpenFilename(Title:="Select Signature To Be Imported")
If fNameAndPath = False Then Exit Sub
 Dim n As Long, lr As Long
lr = Cells(Rows.Count, "H").End(xlUp).Row
Set img = Worksheets("Sheet1").Pictures.Insert(fNameAndPath)
  n = 37
    If Sheets("Sheet1").Rows(n).PageBreak <> xlPageBreakNone Then
    If lr >= n - 11 Then 'this is 5 rows before the page break
    With img
       .Left = 0
       .Top = n + 50 + shp.Top + shp.Height
    End With
    Else
    With img
       .Left = 0
       .Top = shp.Top + shp.Height + 50
    End With
    End If
    End If
End Sub

 

[Michael M]

BTW, you need to actually insert a Page Break at row 37, for the code to work !!!

 

[dpaton05]

That doesn't do much different. It still splits the image if near the bottom of the page.

 

[Michael M]

Did you inert a new page break at cell A37, as mentioned in the previous post ?