Using Macros to "Change picture"

[henki111]

Hi All,
I need to make several hundred excel files which all have the same layout with different information (I.D. Cards). I have resolved all time consuming issues except manually changing the picture for each person. My idea is to write a macro and assign to a button that does the same thing as right-clicking the image and using "Change picture" and then uses information in a cell to find the correct picture (Lastname, firstname.jpg).

Having never worked with excel macros before, you can imagine my dilemma.

Lets say all the pictures are stored under this file path:
C:\MyLocalData\hendrik.voelker\Pictures\Portraits

All the pictures are saved as:
LASTNAME, FIRSTNAME.JPG

If someone could help me out with this issue that would be amazing! Thanks in advance.

 

[Joe4]

Welcome to the Board!

Take a look at the VBA section of this article here: How to change a picture in a worksheet dynamically [VBA]

 

[henki111]

Welcome to the Board!

Take a look at the VBA section of this article here: How to change a picture in a worksheet dynamically [VBA]

Hey Joe4,

Thanks for the quick reply! As far as I can tell the macro code from this article cannot directly change the picture I already have inserted in the sheet (picture, btw, is not in a cell, rather it is free floating) and also will not choose the file with the name of a cell from a specified folder.

Correct me if I'm wrong!

 

[yky]

In my previous job, I needed to send photo quotes to customers. I have a macro that takes the item number from a column, looks up the corresponding photo in a specific directory, and insert it to the quote. This is pretty much what you need.

I have edited it to incorporate the directory you gave above. It needs further modification so it can find the picture file. Such info is lacking in your post. May also need other modifications.

Sub Insert_Pictures()

    Const Sheet_to_Insert_Picture = 1
    Const Note_Starting_Row = 12  'first row to add picture
    Const Picture_Column = 1
    Const FACTOR = 0.9 'ratio of the size of picture vs the size of the cell
    Const Picture_Path = "C:\MyLocalData\hendrik.voelker\Pictures\Portraits\"
    Dim p As Object
    Dim cell_width As Double
    Dim cell_height As Double
    Dim cell_autofit_height As Double   'to store description autofit height
    Dim Top_Offset As Integer   'offset of picture top
    Dim Last_Row As Integer 'last row in thisworkbook.sheets(sheet_to_insert_picture)
    Dim temp_width As Double
    Dim temp_height As Double
    Dim cell_newBook As Range
    Dim cell_value As String
    Dim cell_row As Integer
    Dim search_cell As Range

    newBook.Sheets(1).Pictures.Delete

    Set rng = newBook.Sheets(1).Range(newBook.Sheets(1).Cells(Note_Starting_Row, 2), newBook.Sheets(1).Cells(5000, 2).End(xlUp))

    For Each cell In rng 'go through column B to get item number
        cell_value = Replace(cell.Value, "/", "-") 'need to be modified to find Firstname, Lastname.jpg
        cell_row = cell.Row

        If Len(Dir(Picture_Path &   cell_value & ".jpg")) Then
            Set cell_newBook = newBook.Sheets(1).Cells(cell_row, Picture_Column)

            With ActiveSheet

                Set p = Workbooks(.Parent.Name).Sheets(.Name).Shapes.AddPicture(Filename:=Picture_Path  & _
                    cell_value & ".jpg", LinkToFile:=False, SaveWithDocument:=True, Left:=cell_newBook.Left, _
                    Top:=cell_newBook.Top, Width:=-1, Height:=-1)

                'shrink picture
                p.Width = cell_newBook.Width * FACTOR

                'adjuct row height
                If .Cells(cell_row, Picture_Column).RowHeight < p.Height / FACTOR Then
                    .Cells(cell_row, Picture_Column).RowHeight = p.Height / FACTOR
                End If

                'center picture
                p.Left = cell_newBook.Left + (.Cells(cell_row, Picture_Column).Width - p.Width) / 2
                p.Top = cell_newBook.Top + (.Cells(cell_row, Picture_Column).Height - p.Height) / 2
                            End With

        End If

    Next

    Application.DisplayAlerts = False

    ActiveWorkbook.Save 'savechanges:=True
    Application.DisplayAlerts = True

End Sub 'Insert_Pictures

 

[Joe4]

As far as I can tell the macro code from this article cannot directly change the picture I already have inserted in the sheet (picture, btw, is not in a cell, rather it is free floating) and also will not choose the file with the name of a cell from a specified folder.

Everything that I came across in VBA code seems to suggest that you cannot simply change the details of an existing picture object to change your picture. It appears that you must actually delete the first one, and add the new one. That may actually be what Excel is doing "behind the scenes" when you are doing it manually.

If there is any other way to do it, I have not come across it when I was searching it out.

 

[henki111]

@Joe4 the option of having a macro which deletes the old picture and replaces it with a new one would be fine as long as it keeps the same size and orientation. I also don't know how I would make that code grab the picture named after the specific person whose name is in a cell?

 

[Joe4]

What cell is the name in?
How is the name formatted in the cell (is it formatted the same way that the files are saved, i.e. LASTNAME, FIRSTNAME)?

 

[henki111]

What cell is the name in?
How is the name formatted in the cell (is it formatted the same way that the files are saved, i.e. LASTNAME, FIRSTNAME)?

Name is in cell M15 and yes the file is saved in the exact same format.

 

[Joe4]

To build the whole path and filename for that particular cell, it might look something like this:

Dim fname as String
fname = C:\MyLocalData\hendrik.voelker\Pictures\Portraits\" & Range("M15").Value & ".jpg"

You may want to see if you can use/implement the code that yky posted for you. I think it may need some slight tweaks, but should give you a good start.
It looks like they added lots of comments (in green) to kind of direct you.