Excel εισαγωγή φωτογραφιών βάση κωδικού.

[NOPSTRIM]

Καλησπέρα και καλή χρονιά σε όλους!

Θα ήθελα την βοήθεια σας σε ένα πρόβλημα που έχω.

Έχω ένα φύλλο excel στο οποίο υπάρχουν καμιά 500αρια κωδικοί προϊόντων

και έχω και έναν φάκελο στον οποίο υπάρχουν οι φωτογραφίες τους με ονομασία του αντίστοιχου κωδικού,

θα ήθελα με κάποιο τρόπο δίνοντας το path του φακέλου να πάει να βάλει δίπλα τις αντίστοιχες φωτογραφίες.

πχ στο item code 1 να πάει στον φάκελο και να βάλει στη δίπλα κολόνα την φωτογραφία 1 και αντίστοιχα τα υπόλοιπα.

 

Ευχαριστώ πολύ εκ των προτέρων.

 

 

 

[NOPSTRIM]

Λοιπόν βρήκα ένα scriptάκι για να κάνω αυτό που θελω

Το μόνο που θα ήθελα είναι να μου πει κάποιος πως μπορώ να του πω να κοιτάει πχ την στήλη Α για κωδικό και να βάζει την φωτογραφία στην στήλη Ε

Τώρα όπως λειτουργεί κοιτά κωδικό στην Β και βάζει την φωτογραφία στην Α αλλά δεν βλέπω κάπου Β&Α αντίστοιχα ώστε να τα αλλάξω.

Φαντάζομαι κάτι θα πρέπει να αλλάξω σε αυτό το σημείο.

Set WorkArea = Source.Range(Cells(2, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)

 

Sub Load_Picture()
     
    Dim Entry As Range
    Dim WorkArea As Range
    Dim Source As Worksheet
     
     
    With Application
        .ScreenUpdating = False
    End With
     
     
    Set Source = Sheets("Sheet1")
    Set WorkArea = Source.Range(Cells(2, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2))
     
     
    For Each Entry In WorkArea
        PicturePath = Dir("C:\Pics\" & Entry.Value & ".jpg")
        If PicturePath <> "" Then
            Set Shp = ActiveSheet.Shapes.AddPicture(Filename:="C:\Pics\" & Entry.Value & ".jpg" _
            , LinkToFile:=False, SaveWithDocument:=True, Left:=Cells(Entry.Row, 1).Left, Top:=Cells(Entry.Row, 1).Top _
            , Width:=Cells(Entry.Row, 1).Width, Height:=Cells(Entry.Row, 1).Height)
            Shp.Placement = xlMoveAndSize
            Shp.ControlFormat.PrintObject = True
        Else
            Entry.Offset(0, -1).Value = "Picture Not Found"
        End If
    Next Entry
     
     
End Sub