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]

That code is pretty much what I had, YAY!!, I worked out some code myself.

If the notes textbox is near the bottom of the page though, it will insert the image partly on one page and partly on the next. If this happens, I need it pushed to the second page will it will all appear on the one page.

 

[dpaton05]

Could you help me with this new issue in the last post please Michael?

 

[Michael M]

ONLY LIGHTLY TESTED
you will need to play with lr in relation to where the picture goes.

Sub MM1()
Dim fNameAndPath As Variant
Dim img As Picture, shp As Shape
Set shp = Worksheets("sheet1").Shapes("textbox 1")
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture 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("sheet1").Pictures.Insert(fNameAndPath)
  For h = 1 To 100
    If Sheets("Sheet1").Rows(h).PageBreak <> xlPageBreakNone Then
    If lr >= h - 5 Then 'this is 5 rows before the page break
    With img
       .Left = 0
       .Top = lr + 20 + shp.Top + shp.Height + 50
    End With
    Else
    With img
       .Left = 0
       .Top = shp.Top + shp.Height + 50
    End With
    End If
    End If
  Next h
    
End Sub

 

[dpaton05]

Thanks Michael. I am still having issues with it so I am going to leave it and come back to it later.

 

[Michael M]

whats the issue ??

 

[dpaton05]

whats the issue ??

I have not changed any code yet (not sure what to change), so with the current code:

• It takes about 11 or 12 seconds to insert the picture so I would like to speed that up if I could.
• The image is inserted 4 rows below the bottom of the table, which is right in the middle of the notes box.

I changed the following line of code to have a B instead of an A and that fixed the horizontal alignment.

lr = Cells(Rows.Count, "B").End(xlUp).Row

I updated this line of code to have the correct references to the shape name

Set shp = Worksheets("sheet1").Shapes("textbox 1")

I am just not sure:

• how to get it appearing below the textbox.
• how to speed it up so it isn't so slow.

Thanks

 

[dpaton05]

I just worked part of it out Michael,

I didn't realise that it is case sensitive so I changed it to the correct case and now it is fast enough and it is appearing below the text box.

Only issue left is that it is still splitting the image between 2 pages if it is close to the bottom of the page when the image is inserted.

 

[Michael M]

You need to play with this line, as we don't know the picture size
Try changing the numbers in red, maybe a large number to start with, say 100

.Top = lr + [color=red]20[/color] + shp.Top + shp.Height + 50

 

[Michael M]

or a bit shorter

.Top = lr + [color=red]150[/color] + shp.Top + shp.Height

 

[dpaton05]

I thought of an idea Michael.

What if you had code that measured the distance between 2 lines below the bottom of the box and the end of the page and compared it to the height of the image. If there is not enough room to insert the image between the point below the box and the end of the page, push the image to the next page by inserting a page break before the image?