- Codice: Seleziona tutto
Sub Worksheet_Change(ByVal Target As Range)
Dim mPath As String, mFoto As String, myArea As String, Cella As Range
'
myArea = "A2:A4" '<< Le celle dove potrai scrivere nomi immagini
'
If Application.Intersect(Range(myArea), Target) Is Nothing Then Exit Sub
'
For Each Cella In Target
On Error Resume Next
ActiveSheet.Shapes("FOTO_DA_" & Cella.Address(0, 0)).Delete
On Error GoTo 0
If Cella.Value <> "" Then
mPath = "C:\D\TEMP" ' <<===== QUI scrivi il percorso ove hai le tue foto
mFoto = Cella.Value
If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then ' Si controlla se la foto esiste
Application.ScreenUpdating = False
With ActiveSheet.Pictures.Insert(mPath & "\" & mFoto & ".jpg")
.Top = Cella.Offset(0, 1).Top + 5
.Left = Cella.Offset(0, 1).Left + 5
.Height = Cella.Offset(0, 1).Height - 10
.Width = Cella.Offset(0, 1).Width - 10
.Name = "FOTO_DA_" & Cella.Address(0, 0)
End With
Application.ScreenUpdating = True
Else
MsgBox ("Immagine non trovata: " & Cella.Value) ' <<====== QUI scrivi il messaggio che vuoi sia inviato
End If
End If
Next Cella
End Sub
Saluti e buona giornata e buon lavoro.