Excel lookup images, through VBA.

[shophoney]

Hi,

I'm looking for a way to have my buyers take photos and have Excel look in a folder for the photos.


Below is an example of current code i use. But I would like a quicker way to have Excel look for a photo. To code this for 200 photos would take a long time.

The product for it to look up would be based on the results of my slicer selection from a pivot table.

Being fashion the product will keep changing each week. So I will have thousands of images to look through over time.

Private Sub Worksheet_Change(ByVal Target As Range)

Static oldval

If Range("K3").Value <> oldval Then
    oldval = Range("K3").Value

    Call cmdDisplayPhoto_1_Click
    Call cmdDisplayPhoto_2_Click
  
   Range("K3").Select
   
   Sheets("Percentage Rent").Select
   
End If
End Sub
Private Sub cmdDisplayPhoto_1_Click()

 Sheets("Percentage Rent").Select

Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
Pictur.Select
Pictur.Delete
End If
Next

Dim ModelPhoto As String, Model_1 As String
myDir = "U:\Pictures\Vendors\"
ModelPhoto = Range("F1")
Model_1 = ".jpg"

On Error GoTo errormessage:
ActiveSheet.Shapes.AddPicture Filename:=myDir & ModelPhoto & Model_1, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=5, Top:=135, Width:=80, Height:=80

errormessage:
If Err.Number = 1004 Then

End If
          
End Sub
Private Sub cmdDisplayPhoto_2_Click()

 Sheets("Percentage Rent").Select

Dim myObj
Dim Pictur
Set myObj = ActiveSheet.DrawingObjects
For Each Pictur In myObj
If Left(Pictur.Name, 7) = "Picture" Then
'Pictur.Select
'Pictur.Delete
End If
Next

Dim ModelPhoto As String, Model_2 As String
myDir = "U:\Pictures\Vendors\"
ModelPhoto = Range("C3")
Model_2 = ".jpg"

On Error GoTo errormessage:
ActiveSheet.Shapes.AddPicture Filename:=myDir & ModelPhoto & Model_2, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=2, Top:=250, Width:=85, Height:=85

errormessage:
If Err.Number = 1004 Then

End If
          
End Sub

 

[Domenic]

Instead of selecting and deleting each picture individually, use an array to collect the names of all the pictures, and then delete them all at once. For example, if the array ShapesToDelete contains all the names of pictures to be deleted, you can delete them all at once as follows...

Activesheet.Shapes.Range(ShapesToDelete).Delete

By the way, I see that worksheet "Percentage Rent" contains the pictures. Does it also contain the worksheet change event handler? Or does the change event belong to another worksheet altogether?