Insert photo code

[ipbr21054]

Evening,
I would like some advice on a code to insert a photo into a cell using the command button

Some info for you.
CommandButton2
Path to image is C:\Users\Ian\Desktop
Photo name will always be BAR CODE 1
Photo to be inserted into cell A18
Worksheet is called EBAY

Basically press the command button & then see the photo in cell A18
If any code could be added so the photo is then sized to the cell like width,height,center aligned etc etc
I can then play with it.

Thanks

 

[ipbr21054]

Afternoon,
Just an update as now i have it working after going through it once again.

The code is supplied below.

Private Sub Worksheet_Change(ByVal Target As Range)     
    Application.EnableEvents = False
    
    If Not Application.Intersect(Target, Range("E6,F6,G6,H6,I6,J6,K6")) Is Nothing Then
        Target(1).Value = UCase(Target(1).Value)
    End If


    Dim shp                   As Shape
    Dim picPath               As String
    Dim vFile


    picPath = "C:\Users\Ian\Desktop\BAR CODES\"


    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    If Target.Row Mod 20 = 0 Then Exit Sub
    On Error GoTo son


    For Each shp In ActiveSheet.Shapes
                If shp.Type = msoPicture And shp.TopLeftCell.Address = Target.Offset(0, 1).Address Then
            shp.Delete
        End If
    Next


    If Target.Value <> "" Then
        ChDrive picPath
        ChDir picPath
        picPath = picPath & Target.Value & ".jpg"
        If Dir(picPath) = "" Then    'picture not there!
            If MsgBox("Photo " & Target.Value & " Doesn't exist" & vbCrLf & "Open The Picture Folder ?", vbCritical + vbYesNo, "No Photo Found") = vbYes Then
                ' prompt to select the picture file
                vFile = Application.GetOpenFilename(filefilter:="JPEG image files (*.jpg), *.jpg", Title:="Select image file")
                ' exit if they cancelled
                If vFile = False Then
                    Exit Sub
                Else
                    picPath = vFile
                End If
            Else
                Exit Sub
            End If
        End If
    With Target.Offset(0, 1)
        Set shp = ActiveSheet.Shapes.AddPicture(Filename:=picPath, _
                                                linktofile:=msoFalse, savewithdocument:=msoTrue, _
                                                Left:=.Left + 5, Top:=.Top + 5, Width:=-1, Height:=-1)    ' -1 means use default size
        shp.LockAspectRatio = msoFalse
        shp.Height = .Height - 10
        shp.Width = .Width - 10
    End With
    End If
son:


    Application.EnableEvents = True
End Sub

Could you give me some advice so the import will only happen from typing in cell A17 & A19

Also the trigger work to insert at present is BAR CODE 1

I would also like to add BAR CODE 2

Basically in cell A17 i would type BAR CODE 1 to import the photo.

In cell A19 i would type BAR CODE 2 to import the photo.
This would be the same process all the time.

Thanks

 

[ipbr21054]

All sorted but photos dont get printed as they are imported as a layer Arghhhhhhhhh

 

[ipbr21054]

Any advice please as to how i can print the sheet with the photo that was imported.
Currently importing photo to sheet works fine.
I then print the sheet but where i should see a photo is just a blank space.

I would be grateful if the code could be edited to do so or just just changed even so when i print the sheet it includes the photo.

As this sheet will be used many times the photo must be able to be deleted etc so i can then import another photo next time & also print it the same.

Many thanks.