buondì a tutti,
non capisco cosa c'è che non va.. il codice che vi riporta funziona molto bene, carica delle foto in excel.
il problema nasce quando la foto non esiste dove per la prima che non trova scrive correttamente NA la seconda va in debug il codice in questa istruzione " ActiveSheet.Pictures.Insert" invece dovrebbe andare in errore e scrivere NA..
Sto usando male il On Error GoTo?
Qualcuno ha qualche idea?
codice:
Sub CaricaFoto()
Dim i As Variant
On Error GoTo PictureNotAvailable
Application.DisplayAlerts = False
For e = 4 To Sheets("Aggiorna").Range("C1").Value
foglio = Sheets("Aggiorna").Range("B" & e).Value
origine = Sheets("Aggiorna").Range("C" & e).Value
colonna = Sheets("Aggiorna").Range("D" & e).Value
Sheets(foglio).Select
ActiveSheet.Range("a1").Select
' Ciclo tutte le foto del foglio e le cancello
For Each i In Sheets(foglio).Shapes
If Left(i.Name, 7) = "Picture" Then i.Delete
Next i
' Carico la foto e la ridimensiono con la grandezza della cella
For Each i In Sheets(foglio).Range(origine)
'Se il modello ha uno spazio lo cambio con un underscore
nomefile = Replace(i.Value, " ", "_")
'Seleziono la cella
ActiveSheet.Cells(i.Row, colonna).Select
'Decido dove mettere la foto
var_Width = Sheets(foglio).Columns(colonna).ColumnWidth
var_Height = Sheets(foglio).Cells(i.Row, colonna).Height
'Carico la foto
ActiveSheet.Pictures.Insert("\\luxedge1\LuxPicsCache\parts\wip\default\warn\0" & _
Mid(i.Value, 2, 2) & "\AUTO_600_600\" & nomefile & ".JPG").Select
'Ridimensione la foto
var_Width = Sheets(foglio).Columns(colonna).ColumnWidth
var_Height = Sheets(foglio).Cells(i.Row, colonna).Height
Selection.Width = var_Width
Selection.Height = var_Height
'Aggiungo Hyperlink alla foto
Sheets(foglio).Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:="\\luxedge1\LuxPicsCache\parts\wip\default\warn\0" & _
Mid(i.Value, 2, 2) & "\AUTO_600_600\" & nomefile & ".JPG"
NextPictures:
Next i
'Posiziono il cursore in testa al foglio
ActiveSheet.Range("a1").Select
Next e
'Torno nel foglio principale e avviso che il caricamento è terminato
Sheets("Aggiorna").Select
MsgBox ("Caricamento foto terminato!"), vbInformation
Fine_aggiornamento:
Exit Sub
PictureNotAvailable:
ActiveSheet.Cells(i.Row, colonna).Value = "N.A."
GoTo NextPictures
End Sub