Insert image jpg/jpeg and align within range

[Vitje]

Hello everyone,

I have looked long and hard for some kind of a solution to my query. Many different posts online regarding inserting images etc. However, unable to find a solution for what I'd like to achieve. Also my VBA is rubbish.

To start, I have a template with a data validation dropdown menu linked to a dynamic list. When selecting a customer from the list it populates the template.

At the moment I have a button in place that I press after having selected the customer. What this does is it adds two pictures to the template (Every customer has his/her own two pictures. Never more, never less)

The code behind the button is as follows:

Sub InsertPic()

For Each Shape In ActiveSheet.Shapes
 If Left(Shape.Name, 7) = "Picture" Then
  Shape.Delete
 End If
Next

    Dim objPicture As Picture
    With Sheet1.Cells(164, 2)
        Set objPicture = .Parent.Pictures.Insert(Sheet1.Cells(2, 13).Value)
        objPicture.Top = .Top
        objPicture.Left = .Left
        objPicture.Height = 200
        
    End With
    
    With Sheet1.Cells(182, 2)
        Set objPicture = .Parent.Pictures.Insert(Sheet1.Cells(3, 13).Value)
        objPicture.Top = .Top
        objPicture.Left = .Left
        objPicture.Height = 200
        
    End With
    
End Sub

What the code does:
First off, it deletes the pictures from the previous list selection (otherwise it will keep stacking the images over each other increasing file size).

After that it looks at column 13 rows 2 and 3 where I have the two links to the pictures.
Example:
C\Test\pic1.jpg
C\Test\pic2.jpg

The pictures are inserted into the sheet in column 2 rows 164 and 184 with a fixed height.


All pretty good so far, however......the pictures tend to be *.jpg or *.jpeg, causing the script to fail when it regards a *jpeg because the cell containing the link always has the following formula:

="C\Test" & A2 & ".jpg" (with A2 containing the name of the picture linked to the list selection)

Also the pictures tend to be of different sizes making me have to scroll down and reposition them every time.
All in all it works but could be better as I'm looking at 2000+ customers that I need to report to.

So if anyone can help with the following:
- How can I get the script to open the file in the path location regardless of it being *.jpeg or *.jpg?

- How do I get the images centered with the following two ranges as their max heights will always be 200

• Pic1: Range("A164:G179")
• Pic2: Range("A182:G197")

- And finally I'd like to have this set off automatically after making the selection but I'm pretty sure I can get that done myself with an ActiveX dropdown menu instead of the data validation list.

I know, lot of text, trying to be as clear as possible. Thanks in advance for reading this wall of text.

 

[John_w]

You could omit the ".jpg" part of the formula:

="C\Test" & A2

and change the code look for the .jpg file or the .jpeg file using the Dir function, and insert the correct picture like this (assuming Cells(2, 13) contains that formula)::

    Dim p As Long, filePath As String, fileName As String, dirFile As String

    With ActiveSheet.Cells(2, 13)
        p = InStrRev(.Value, "\")
        filePath = Left(.Value, p)
        fileName = Mid(.Value, p + 1)
    End With
    
    dirFile = Dir(filePath & fileName & ".jpg")
    If dirFile = "" Then dirFile = Dir(filePath & fileName & ".jpeg")
    fileName = dirFile
    Set objPicture = ActiveSheet.Pictures.Insert(filePath & fileName)

and similarly for the 2nd picture.

To centre the pictures, calculate the centre .Top and .Left positions:

    With ActiveSheet.Range("A164:G179")
        objPicture.Top = .Top + .height \ 2 - 200 \ 2
        objPicture.Left = .Left + .Width \ 2 - objPicture.Width \ 2
    End With

and the same for the other range.

 

[Vitje]

John_w, Thanks a lot!

Working perfectly