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

 

[Nine Zero]

so you can do this by putting this under the commandbutton2 click action

    Sheets("EBAY").Select
    Range("A18").Select
    ActiveSheet.Pictures.Insert( _
        "[COLOR=#333333]C:\Users\Ian\Desktop[/COLOR]\BAR CODE 1.jpg").Select

I added the .jpg at the end since idk what extension format you are using

 

[ipbr21054]

Hi,
Ive changed it to PNG

I see a message,unable to get the insert property of the picture class

 

[ipbr21054]

My mistake,
I had an extra space.
It now inserts the photo but not in any specific cell but just anywhere

 

[Nine Zero]

Make sure the picture is name properly, check the path, anything like that .... 99% of the time that error means it cant find that picture in the location you have specified

EDIT: ok i see you found the issue good job... ummm it inserts the picture in cell A18, well the top left corner will be in A18

 

[Nine Zero]

try this out now

    Dim loc As String
    loc = InputBox("Type cell location to place the image. Example: A18", "Cell Location")
    If loc = vbNullString Then
        MsgBox ("User canceled!")
    Else
    Sheets("EBAY").Select
    Range("A18").Select
    ActiveSheet.Pictures.Insert( _
        "C:\Users\Ian\Desktop\BAR CODE 1.png").Select
    End If

add this to the button click

 

[ipbr21054]

Hi,
Thats the same.

 

[Nine Zero]

So the image gets inserted, and is the top left corner in cell A18? or whatever cell you typed in the box?

technically if the size of the image is big or small, regardless of size, the top left corner of the image will be placed in the given cell you will then have to resize it manually

 

[ipbr21054]

Hi,
I will need to keep looking.
The photo is inserted but gets placed around row 3 & 4

 

[ipbr21054]

Hi,
I have found a code that @MAIT supplied some time ago.
I use it on another sheet and does exactly what i require.

So i have now copied the code to put it onto another sheet where i would like to also use it.
The code is shown below.

Now the problem that i have is the photo to be imported is png.
So i change this in the code but when i type in cell A nothing happens.
If i changed the code back to JPG and then try to import my PNG photo i now get to see the Not found message.

Do you see an issue with this as to why it will not import the photo.

Thanks

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