Ci sono due opzioni:
1) Far partire una macro quando una singola cella viene modificata (nb: "viene" modificata, non "si modifica" per effetto di una formula), in modo che una immagine corrispondente venga inserita nel foglio di lavoro.
Oppure
2) Avviare una macro che inserisce tutte le immagini che corrispondono a un certo elenco di celle; l' elenco di celle puo' essere (a)scritto nella macro (quindi "semi-fisso") o puo' corrispondere a un elenco che puo' essere (b)selezionato o (c)dichiarato dall' utente con vari metodi di input.
Sulla base di quanto dicesti nel primo messaggio il metodo 1 e' inapplicabile ("I nomi delle fotografie sono il risultato di un concatenamento di altre celle"); l'assenza di un file esemplificativo impedisce di capire se il metodo e' applicabile usando altri "agganci".
La Sub MettImm() che ti ho suggerito qualche giorno fa opera secondo il metodo 2a.
Gli hai dichiarato un intervallo di 1 milione di celle in cui puoi scrivere le immagini, quindi la macro controllera' un milione di celle e per questo impieghera' il suo tempo...
Volendo in controllare l' intervallo di celle da controllare, invece della riga
myArea = "A2:A150" '<< Le celle dove potrai scrivere nomi immaginipotresti inserire le istruzioni
- Codice: Seleziona tutto
On Error Resume Next
Set mmArea = Application.InputBox("Seleziona l' Intervallo", , , , , , , 8)
On Error GoTo 0
If IsEmpty(mmArea) Then Exit Sub
myArea = mmArea.Address
Veniamo al problema successivo: le immagini non riultato "integrate" nel foglio ma solo "collegate", per cui se l' archivio immagini non e' disponibile viene solo evidenziato un "segnaposto".
Questo succede perche' a partire da XL2010 il "metodo Insert" (usato all' interno della Sub MettImm) si limita a creare un link all' immagine, non la inserisce realmente come faceva nelle versioni precedenti.
Per compatibilita' con le versioni successive useremo quindi ActiveSheet.Shapes.AddPicture, con gli adattamenti richiesti dalla sintassi di questo comando; quindi la nuova macro complessiva sara':
- Codice: Seleziona tutto
Sub MettImmZZ()
Dim mPath As String, mFoto As String, myArea As String, Cella As Range
Dim myT As Long, myL As Long, myH As Long
'
'myArea = "A2:A150" '<< Le celle dove potrai scrivere nomi immagini
On Error Resume Next
'Qui si seleziona l' area in cui sono presenti i nomi Foto:
Set mmArea = Application.InputBox("Seleziona l' Intervallo coi Nomi Foto", , , , , , , 8)
On Error GoTo 0
If IsEmpty(mmArea) Then Exit Sub 'Nessuna selezione, abort
myArea = mmArea.Address
'
For Each Cella In Range(myArea)
On Error Resume Next
ActiveSheet.Shapes("FOTO_DA_" & Cella.Address(0, 0)).Delete
On Error GoTo 0
If Cella.Value <> "" Then
mPath = "F:\Backup disco D\Documenti Mauro\Immagini\Per vendita\004 Archivio foto inviate" ' <<===== 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
'
myT = Cella.Top + 5
myL = Cella.Offset(0, 1).Left + 5
myH = Cella.Height - 10
'
Set CPic = ActiveSheet.Shapes.AddPicture(mPath & "\" & mFoto & ".jpg", False, True, myL, myT, True, True)
CPic.LockAspectRatio = msoTrue
CPic.ScaleHeight (myH / CPic.Height), msoTrue
CPic.Name = "FOTO_DA_" & Cella.Address(0, 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
L' immagne viene ridimensionata sull' altezza della cella, mentre la larghezza rimane in proporzione all' originale.
In XL2010 il "peso" (in KB) dell' immagine salvata e' automaticamente proporzionato alla dimensione, non c' e' bisogno di ulteriori interventi.
Prova e fai sapere.
non saprei come fare per allegare alla chat un file (Ignoranza mia)
Hai letto con poca attenzione, quindi lo ripeto: Per come [allegare un file dimostrativo] guarda qui: viewtopic.php?f=26&t=103893&p=605487#p605487
Ciao