Anthony47 ha scritto:Ho guardato il file Commerciale.rar e il suo ImportaImmaginiDaElenco.xls.
Il file intendeva realizzare la seguente prestazione:
-quando si modifica una o piu' celle nel range E1:E41 (l' intervallo col nome "ELENCO_ARTICOLI")...
-si legge il valore di ogni cella a partire dalla prima modificata verso il basso
-si cerca nella directory C:\Temp la presenza di una immagine jpg avente nome pari al contenuto della cella
-se esiste si inserisce quell' immagine, la si ridimensiona e la si posiziona in col J
-se non esiste si inserisce una foto di default (immagine ImmStandard.jpg, sempre dalla stessa directory)
Le immagini devono essere presenti in una directory definita nel codice macro, puo' essere diversa per le immagini vere e per quella di default.
Purtroppo ci sono un paio di errori che falsano la realizzazione di questo obiettivo:
-Nella macro Sub Worksheet_Change l' istruzione
Selection.Name = "FOTO_DA_" & Target.Offset(0, 0).Address(0, 0) e' malauguratamente "commentata", per cui non viene eseguita, col risultato che piu' immagini (uguali o diverse) vengono inserite in col J.
-In ogni caso il meccanismo di rename delle immagini e' falsato, perche' tutte le immagini manipolate in un ciclo vengono rinominate con lo steso nome; strano ma vero, excel non si offende ad avere 1, 10 o 100 immagini tutte con lo stesso nome. Salvo che poi ne cancella una sola. Col risultato che.... piu' immagini (uguali o diverse) vengono inserite in col J.
Il mio suggerimento e' di sostituire integralmente la macro Worksheet_Change contenuta nel file e sostituirla con questa versione:
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
'
ListaF = "E1:E41" '<<< Le celle con nome immagine
For Each Cella In Target
If Not Application.Intersect(Cella, Range(ListaF)) Is Nothing Then
On Error Resume Next
ActiveSheet.Shapes("FOTO_DA_" & Cella.Address(0, 0)).Delete
On Error GoTo 0
Cella.Select
If Dir("C:\TempPIPPO\" & Cella.Text & ".jpg") = "" Then '<1
ActiveSheet.Pictures.Insert("C:\TempPIPPO\ImmStandard.jpg").Select '<2
Else
ActiveSheet.Pictures.Insert("C:\TempPIPPO\" & Cella.Text & ".jpg").Select '<1
End If
Selection.Name = "FOTO_DA_" & Cella.Address(0, 0)
Selection.ShapeRange.Height = 79
If Selection.ShapeRange.Width > 150 Then
Selection.ShapeRange.Width = 150
End If
'PER POSIZIONARE L'IMMAGINE
Selection.ShapeRange.Left = Cella.Offset(0, 5).Left
Cella.Select
End If
Next Cella
End Sub
Nelle righe marcate <1 dovete inserire la directory dove sono reperibili le foto da inserire
Nella riga marcata <2 va la directory + il nome dell' immagine di default.
Nella riga marcata <<< inserite l' indirizzo delle celle che dovrebbero contenere il nome di una immagine da inserire.
Se avete elaborato un file di produzione (con dati veri) e non avete piu' il file originale allora
1) la prossima volta fate le vostre prove sempre su una copia dei dati
2) procedete con questo ripristino, DOPO AVER FATTO DUE COPIE DI BACK-UP DEL FILE CORRENTE:
2a) Per eliminare le immagini al momento presenti in col J potete usare questa macro, da usare una sola volta:
- Codice: Seleziona tutto
Sub Delall()
'cancella tutte le immagini di colonna J (colonna 10)
For Each pict In ActiveSheet.Shapes
If pict.TopLeftCell.Column = 10 Then pict.Delete
Next pict
End Sub
RIPETO: elimina tutte le immagini e le forme che hanno l' angolo alto a sx in col J
2b) Per creare in col J tutte le immagini come da contenuto della colonna E potete invece usare questa macro:
- Codice: Seleziona tutto
Sub PutAll()
'Crea le immagini come da lista presente nel range ListaF
ListaF = "E1:E41" '<<< Le celle con nome immagine
For Each Cella In Range(ListaF)
OldV = Cella.Value
Cella.ClearContents: Cella = OldV
Next Cella
End Sub
PutAll presuppone che la macro di Worksheet_Change sia gia' stata modificata come suggerito prima.
Questa seconda macro, PutAll, puo' anche risolvere la domanda fatta da joe.cnt, che pero' dovra' adattare la macro Worksheet_Change come segue
a) Adattare questa riga ai propri dati:
- Codice: Seleziona tutto
ListaF = "E1:E41" '<<< Le celle con nome immagine
b) Modificare questa riga per impostare col B
- Codice: Seleziona tutto
'PER POSIZIONARE L'IMMAGINE '<<< esistente
Selection.ShapeRange.Left = Cella.Offset(0, 1).Left 'Modificata
In questo modo, cioe', sara' possibile sia eseguire in blocco l' inserimento delle immagini sia modificare una singola immagine, modificando la relativa cella di col A
Buon test a tutti.
Registrazione
