Quanto alle immagini mancanti secondo me e' che in quei casi inserisci una immagine specifica di "Immagine Mancante".
Per questo userai questa versione della macro precedente:
- 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:A150" '<< Le celle dove potrai scrivere nomi immagini
'
If Application.Intersect(Range(myArea), Target) Is Nothing Then Exit Sub
'
For Each Cella In Application.Intersect(Range(myArea), Target)
On Error Resume Next
ActiveSheet.Shapes("FOTO_DA_" & Cella.Address(0, 0)).Delete
On Error GoTo 0
If Cella.Value <> "" Then
mPath = "C:\TempFoto" ' <<===== QUI scrivi il percorso ove hai le tue foto
mFoto = Cella.Value
'** If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then ' Si controlla se la foto esiste
If Dir(mPath & "\" & mFoto & ".jpg") = "" Then mFoto = "Missing" ' <<** Se foto non esiste inserire foto di Riempimento
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
On Error Resume Next
With ActiveSheet.Shapes("FOTO_DA_" & Cella.Address(0, 0))
.LockAspectRatio = True
.Height = Cella.Height - 10
If .Width > Cella.Offset(0, 1).Width Then .Width = Cella.Offset(0, 1).Width - 10 '***
End With
On Error GoTo 0
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
Le righe che cominciano con '** sono state eliminate; la riga marcata <<** e' stata aggiunta, e va personalizzata col nome dell' immagine generica che verra' inserita in assenza della foto specifica; questa immagine deve essere presente nella directtory delle immagini.
Ciao
