Insert and resize photos

[moonbreakker]

Hello,

I am new to vba and only know basics. I am not even sure if this can be done via VBA. What i am trying to do is:

1. I have hundreds of workbooks in a folder -- Same format -- same structure -- same size -- same fonts -- but different data.
2. I want to insert photographs in the workbook -- Save workbook --- exit.

Workbook basically is a set of 4 clinical cards for employees of a company. It has basic details like blood group, BP, height, weight, cholesterol etc. All that is done and functional. Each book has 4 cards. What you see in attached workbook is front and back side of a card. It gets printed and folded from center to create a health card of an employee.

What i want to do is:

1. I have left empty space in card. K8 to L10.
2. I have a folder with jpeg images of employees. Images are named on their EMP ID (employee ID) 7868.jpeg, 2423.jpeg etc..and UNIQUE.

I want to insert photos into these hundreds of workbooks and resize them and fit into

K8 to L10 empty space (first card)
K25 to L27 (second) and so on for 4 cards..

Workbooks are in a folder and named as 1,2,3,4.xlsx etc. I can set path of workbooks and path of pictures.

If image is not found we can skip for that card. Hmmm For years, what i am doing is, Go to-->inserting image --> drag to the place---> resize---> adjust.
It's very tedious work for 100s of files every week. Is there anyway to automate this? If so, i will worship VBA for years to come.

Please find attached workbook.

[moonbreakker]

I can create a workbook which has columns.

A -- Path and name of the workbook with 4 cards.
B -- jpeg file name of first card
C--- jpeg file name of second card and so on..

All that can be done. I have a central data to extract required info for coding if required.

Thank you.

[humdingaling]

Sub InsertPic()
    
    Dim i As Integer 'counter for loop
    Dim strPath As String 'string for path
    Dim rng As Range 'range for top and left of image without loop
    
    'this is to declare where photos are stored
    'taken assumption that the photos are subdirectory of this file,change as required
    strPath = ThisWorkbook.Path & "\Photos\"
    
    i = 1
    
    For i = 1 To 4
        'set rng to where the the top and left of image will be. ie K8,K25,etc
        Set rng = Cells(((i - 1) * 17) + 8, 11)
        
        'take the Emp ID from column N
        With ActiveSheet.Pictures.Insert(strPath & Cells(((i - 1) * 17) + 10, 14).Value & ".jpeg")
            With .ShapeRange
                .LockAspectRatio = msoFalse
                .Width = 85
                .Height = 35
            End With
            .Left = rng.Left
            .Top = rng.Top
            .Placement = 1
            .PrintObject = True
        End With
    Next
    
End Sub

play around with the width/height until you get it right

**
to use test file make subdirectory of the attached file named "Photos" and place jpeg in there

[moonbreakker]

ok..hmm let me play around on the weekend. Will get back to you on Monday. Thank you so much for your time.