[EXCEL] INSERIMENTO AUTOMATICO IMMAGINI

[commerciale]

Buongiorno,
Ho creato una macro che, inserendo un nome in una cella della colonna A (Elenco_Articoli) mi restituisce sulla stessa riga, nella colonna F, la relativa foto abbinata (ricercandola sul server di rete).
Ho bisogno di un chiarimento riguardo i 4 punti seguenti:

1: E' NECESSARIO INSERIRE: " 'Target.Offset(1, 0).Select " ?
Copiato "spudoratamente" da un vostro forum non riesco a capire se, nel mio caso, è essenziale o meno; per il momento direi di no, gli ho messo l'apice e non mi crea problemi...

2: PROBLEMA FOTO MANCANTE - Capita che inserendo nella colonna A un nome al quale non è abbinata una foto mi vada in Debug... Visto che devo dare questo file a persone inesperte, è possibile far si che in questo caso appaia un'immagine standard ad es. con la scritta "immagine non disponibile"?

3: PROBLEMA POSIZIONAMENTO - Come da Routine sotto riportata potete notare che ho dato istruzione di inserire l'immagine allineata alla riga dove ho inserito il codice nella 5A colonna; il mio problema è che tutte le foto sono di dimensioni diverse: è possibile centrarle nella colonna 5 indipendentemente dalla relativa dimensione?

4: INSERIMENTO MULTIPLO: il tutto funziona se inerisco un nome dopo l'altro nella colonna A; non funziona se invece ad es. copio una serie di nomi e la incollo nella colonna. Perchè?

ISTRUZIONI UTILIZZATE

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("ELENCO_ARTICOLI")) Is Nothing Then Exit Sub
On Error Resume Next
    ActiveSheet.Shapes("FOTO_DA_" & Target.Offset(0, 0).Address(0, 0)).Delete
On Error GoTo 0

'Target.Offset(1, 0).Select
ActiveSheet.Pictures.Insert("\\Nas-mac\apple2\Offerte Fotografiche\Articoli 300\IMMAGINI\" & Target.Value & _
".jpg").Select
Selection.Name = "FOTO_DA_" & Target.Offset(0, 0).Address(0, 0)

'Selection.ShapeRange.Width = 150 (per fissare larghezza)
'Selection.ShapeRange.Height = 80 (per fissare altezza)
Selection.ShapeRange.Height = 79
If Selection.ShapeRange.Width > 150 Then
Selection.ShapeRange.Width = 150
End If
'Selection.ShapeRange.Width = 150

'PER POSIZIONARE L'IMMAGINE
Selection.ShapeRange.Left = Target.Offset(0, 5).Left
Selection.ShapeRange.Top = Target.Offset(0, 0).Top

Target.Select
End Sub

Grazie mille
Saluti
Stefano

[Flash30005]

1) No, serve per spostarsi di una colonna rispetto alla posizione precedente e non credo occorra al tuo caso

2) Sistemato problema con la macro che posterò più in basso

3) se le immagini sono diverse puoi solo dare un larghezza fissa per tutte ma avrai delle immagini "deformate" in quelle dove la larghezza è inferiore

4) Con la modifica della macro questo punto è risolto

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("ELENCO_ARTICOLI")) Is Nothing Then Exit Sub
On Error Resume Next
    ActiveSheet.Shapes("FOTO_DA_" & Target.Offset(0, 0).Address(0, 0)).Delete
On Error GoTo 0
UR = Range("E" & Rows.Count).End(xlUp).Row
For RR = Target.Row To UR
Cells(RR, 5).Select
MsgBox Cells(RR, 5).Text
If Dir("\\Nas-mac\apple2\Offerte Fotografiche\Articoli 300\IMMAGINI\" & Cells(RR, 5).Text & ".jpg") = "" Then
ActiveSheet.Pictures.Insert("\\Nas-mac\apple2\Offerte Fotografiche\Articoli 300\IMMAGINI\ImmStandard.jpg").Select
Else
ActiveSheet.Pictures.Insert("\\Nas-mac\apple2\Offerte Fotografiche\Articoli 300\IMMAGINI\" & Cells(RR, 5).Text & ".jpg").Select
End If
Selection.Name = "FOTO_DA_" & Target.Offset(0, 0).Address(0, 0)

'Selection.ShapeRange.Width = 150 (per fissare larghezza)
'Selection.ShapeRange.Height = 80 (per fissare altezza)
Selection.ShapeRange.Height = 79
If Selection.ShapeRange.Width > 150 Then
Selection.ShapeRange.Width = 150
End If

'PER POSIZIONARE L'IMMAGINE
Selection.ShapeRange.Left = Cells(RR, 10).Left
'Selection.ShapeRange.Top = Target.Offset(0, 0).Top

Next RR
End Sub

Ciao

[commerciale]

Grazie Flash,
Ho provato ad inserire la macro che mi hai girato ma non funziona più praticamente nulla... ho creato anche il file ImmStandar.jpg e mi da solo questa foto... non capisco...
Mi puoi chiarire i vari punti che hai modificato così imparo anche?

Grazie
Stefano

[Flash30005]

Ok la maggior parte dei codici li ho presi dalla tua macro ma per evitare che vada in errore quando non trova un file ho inserito questa condizione

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
...
'MsgBox Cells(RR, 5).Text <<<< questa riga va commentata o cancellata
If Dir("\\Nas-mac\apple2\Offerte Fotografiche\Articoli 300\IMMAGINI\" & Cells(RR, 5).Text & ".jpg") = "" Then
ActiveSheet.Pictures.Insert("\\Nas-mac\apple2\Offerte Fotografiche\Articoli 300\IMMAGINI\ImmStandard.jpg").Select
Else
ActiveSheet.Pictures.Insert("\\Nas-mac\apple2\Offerte Fotografiche\Articoli 300\IMMAGINI\" & Cells(RR, 5).Text & ".jpg").Select
End If
...End Sub

E' importante che quel percorso esista altrimenti dovrai mettere un percorso del tuo HD (come ho fatto io nelle prove)

Per il punto 4, invece faccio scansionare tutte le righe a partire dalla prima Targhet.row alla fine delle righe incollate UR

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
...
UR = Range("E" & Rows.Count).End(xlUp).Row
For RR = Target.Row To UR  '<<<< RR sarà il numero di riga che inizia dall'inizio range di incollaggio alla fine
Cells(RR, 5).Select  '<<< seleziona di volta in volta la cella del nome file
...
...
'Selection.Name = "FOTO_DA_" & Target.Offset(0, 0).Address(0, 0) '<<<< questa riga non serve

'...
...
Selection.ShapeRange.Left = Cells(RR, 10).Left '<<< essendo una colonna fissa la 10 (J) non occorre mettere l'offset
Next RR
End Sub

ImmStandard è con la "d" finale e non ImmStandar.jpg

Non capisco come faccia a non funzionare, suppongo che il percorso del file non sia quello corretto
Ricontrolla
Ciao

[commerciale]

Ciao,
Ho provato anche dal pc di casa cambiando il riferimento con una cartella di foto che ho sul pc...
Mi funziona solo per la prima riga e mi inserisce sempre e solo la foto ImmStandard... Sul tuo pc sicuro che funziona? non capisco...

[Flash30005]

Ti invio un file archivio che contiene il file excel con la macro postata e 3 file immagini.jpg

http://uploading.com/files/e1be83b5/Commerciale.rar/

il file di excel puoi metterlo dove vuoi ma le 3 immagini le devi mettere in C:\Temp\

avvia il file excel e prova ad inserire un numero tra quelli che vedi già inseriti (571, 572 esiste immagine)
per tutti gli altri numeri avrai l'immagine dei "carabinieri"

Altrimenti qui non ne usciamo fuori!!!

ciao

[commerciale]

Scusa il ritardo...
Ho provato il tuo file, confermo che inserisce le foto ma le posiziona tutte nello stesso punto... A me necessita che siano ancorate ad una data cella (così funziona anche il filtro automatico di excel).
Inoltre se cambio una cella non mi cancella la foto precedente...

Saluti
Stefano

[Anthony47]

Suggerisco di dare uno sguardo a questa discussione viewtopic.php?f=26&t=92794, in particolare questo post: viewtopic.php?f=26&t=92794#p530525

Ciao

[joe.cnt]

Ciao a tutti, spero che qualcuno mi può aiutare.
Ho un file di excel dove nella colonna A ho i nomi di oltre 1000 immagini .jpg che ho su una cartella, vorrei che le immagini corrispondenti venissero visualizzate nella colonna B.
Vorrei farlo in modo automatico e non a una ad una.
Grazie a chiunque mi possa aiutare.
Joe

[Flash30005]

Ciao Joe.cnt e benvenuto nel Forum

I suggerimenti forniti in questo topic non sono sufficienti?

Ci sono macro funzionanti da copiare e incollare (adattando i percorsi e poco altro) e anche esempi con link che riportano a casi specifici.

fai sapere
Ciao

[joe.cnt]

Ti invio un file archivio che contiene il file excel con la macro postata e 3 file immagini.jpg

(...)

il file di excel puoi metterlo dove vuoi ma le 3 immagini le devi mettere in C:\Temp\

avvia il file excel e prova ad inserire un numero tra quelli che vedi già inseriti (571, 572 esiste immagine)
per tutti gli altri numeri avrai l'immagine dei "carabinieri"

Altrimenti qui non ne usciamo fuori!!!

ciao

Ho pravato il tuo esempio è ho riscontrato lo stesso problema di commerciale

Scusa il ritardo...
Ho provato il tuo file, confermo che inserisce le foto ma le posiziona tutte nello stesso punto... A me necessita che siano ancorate ad una data cella (così funziona anche il filtro automatico di excel).
Inoltre se cambio una cella non mi cancella la foto precedente...

Saluti
Stefano

e ho notato che ogni volta che cambio un valore o inserisco un valore nella colonna E quella dei riferimenti delle foto, ricarica tutte le foto, nel mio caso che ne ho qualche miglia non mi consentirebbe di lavorare.

Grazie per l'aiuto che puoi fornirmi.
Ciao

[Anthony47]

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.

[commerciale]

Grazie mille Anthony,
Però ho ancora alcuni problemi...

Tornando alle mie quattro richieste iniziali ad inizio del topic direi che i punti 1 e 2 sono risolti.

Per il problema 3 (problema posizionamento immagine) ho aggiunto una riga per "agganciare" la foto in alto a sinistra della cella:

Codice: Seleziona tutto

    'PER POSIZIONARE L'IMMAGINE
    Selection.ShapeRange.Left = Cella.Offset(0, 5).Left
    Selection.ShapeRange.Top = Target.Offset(0, 0).Top   <<< Riga Aggiunta
    Cella.Select

Mi confermi che non è possibile "agganciare" il centro dell'immagine al centro di una cella? (Purtroppo le immagini sono di misure completamente diverse, quindi la foto di una biro ad esempio mi risulta poco visibile perchè attaccata al bordo della cella)

Per il problema 4 (inserimento multiplo) mi da ancora errore se inserisco tramite incolla dati in più celle; mi confermi che tramite macro Worksheet_Change non è possibile avere questo automatismo e serve un'altra macro?

Altri chiarimenti:
- La macro per eliminare le immagini non funziona (o fatto le prove anche modificando il riferimento di colonna)
- La macro per inserire le immagini mi da due problemi:
a) inserisce solo l'immagine standard di default (comunque la inserisce nella colonna e riga giusta)
b) Cancella tutti i dati della LisfaF (sta scritto nella macro infatti ma non so con cosa sostituirlo e come mai è stato fatto)
Ti chiedo inoltre chiarimenti sulla funzione OldV che hai utilizzato

Grazie Anticipato!!

[Anthony47]

La macro nei miei test gestisce inserimenti multipli tramite copia e incolla, sia copiando da celle excel che copiando ad es da notepad (copia e poi incolla o incolla speciale /valori). A te che problemi da?

La macro elimina tutte le forme, compreso le immagini, che hanno l' angolo top-left dentro la colonna J; se hai spostato le immagini allora non funzionera', ma se le hai lasciate al loro posto dovrebbe funzionare; hai qualche altro indizio per me?

La macro che inserisce tutte le immagini ha un solo problema: ha un piccolo ma sostanziale errore. Correggete questa riga:

Codice: Seleziona tutto

Cella.ClearContents: Cella.Value = OldV   '<<< Mancava un piccolo .Value


OldV e' una variabile in cui salvo il contenuto della cella prima di cancellarla e poi ripristinarla; serve per far scattare la macro standard di Worksheet_Change e posizionare l' immagine.

Per posizionare le immagini al centro della cella devi solo fare un gioco di aritmetica, che porta a queste istruzioni, da sostituire alle attuali:

Codice: Seleziona tutto

    'PER POSIZIONARE L'IMMAGINE
    Selection.ShapeRange.Left = Cella.Offset(0, 5).Left - Selection.ShapeRange.Width / 2 + Cella.Offset(0, 5).Width / 2
    Selection.ShapeRange.Top = Cella.Offset(0, 0).Top - Selection.ShapeRange.Height / 2 + Cella.Offset(0, 5).Height / 2


Ciao

[commerciale]

Anthony grazie mille!
Il giochino aritmetico l'avevo pensato ma non sarei mai riuscito a metterlo in pratica!!

Gli inserimenti multipli a me non li gestisce, sotto ti riporto l'errore di debug che mi da:



La macro di inserimento automatico ora funziona benissimo, il tutto risulta leggermente lento ma inserisce immagini non semplici dati....

A questo punto per completare il tutto credo mi manchi di scoprire solo come modificare la cancellazzione di tutte le foto (==> If pict.TopLeftCell.Column = 5 Then pict.Delete)... mi aiuti anche qui?

SUGGERIMENTO: Questo file per me è molto simpatico e utile, con possibilità di utilizzarlo per tanti scopi.... Il problema generale è che io riesco a modificarlo ma molti ragazzi "negati" per excel non saprebbero dove mettere le mani... Che ne dici se in seguito creiamo un excel dove i dati principali (ListaF, cartella immagini da inserire, colonna dove inserire le foto ecc) si inseriscono direttamente in un foglio iniziale excel e non in visual basic e poi mettere questo file excel a disposizione per tutti??

Saluti
Stefano

[Anthony47]

Gli inserimenti multipli a me non li gestisce, sotto ti riporto l'errore di debug

Ben ti sta', cosi' impari a copiare la macro che avevo suggerito io (ma perche' poi non hai fatto copia /incolla pari pari??)

La macro per cancellare: conosco un paio di motivi per cui potrebbe andare in errore o non cancellare, ma se dici solo che non funziona senza dire che cosa ti succede posso solo suggerire di chiedere sul forum di www.lostregone.com
Inoltre quella macro era stata suggerita per cancellare le immagini inserite in col J con la Worksheet_Change che non le rinominava; insomma il suo uso era limitato all' eventuale recupero di file inquinati, al di fuori di questo caso il suo utilizzo e' superfluo.

L' idea di mettere a disposizione il file risultante l' approvo; ma questo e' un forum di suggerimenti, non di prodotti finiti. Insomma qui l' utente deve sempre fare la sua parte, che presuppone un minimo di operativita'.

Ciao

[commerciale]

Scusa Anthony!!
Quando ho cambiato i riferimenti per la mia cartella immagini ho copiato tutto quello che stava tra parentesi... con il risultato che si è visto...

La macro per cancellare: credevo fosse sottointeso che non avendo più le immagini agganciate all'angolo sinistro della cella (come da modifica suggerita da te) la macro non potesse funzionare... Invece riprovando funziona alla grande!!!!
TUTTO OK!! Grazie mille!!! ...e soprattutto scusa...

Ora un aiuto per "l'implementazione":
Ad esempio se voglio che la cartella immagini sia scritta nella cella A1 del foglio1 basta sostituire "\\Nas-mac\ecce" con Cella.value(0,0) o con altra dicitura??

[Anthony47]

Puoi mettere alcuni parametri su un foglio, che magari chiami "Parametri"; poi ad esempio userai

Codice: Seleziona tutto

ListaF=Sheets("Parametri").Range("B2").value
StdDir= Sheets("Parametri").Range("B3").value :If Right(StdDir,1)<>"\" then StdDir=StdDir & "\"
DefPic= Sheets("Parametri").Range("B4").value     'Dir e filename da usare in mancanza di foto


Poi richiamerai queste variabili con

Codice: Seleziona tutto

If Dir(StdDir & Cella.Text & ".jpg") = "" Then   
    ActiveSheet.Pictures.Insert(DefPic).Select 
 Else
    ActiveSheet.Pictures.Insert(StdDir & Cella.Text & ".jpg").Select


Una qualche automazione in piu' potresti farla usando strumenti che guidano l' utente nella scelta; ad esempio per scegliere la Dir delle immagini potresti usare Application.FileDialog(msoFileDialogFolderPicker) mentre per scegliere il file di default Application.FileDialog(msoFileDialogFilePicker)
L' help on line contiene validi esempi su come si usa FileDialog, e nel forum trovi altri esempi.

Ciao

[commerciale]

Sto seguendo i tuoi consigli ma mi areno qui:

Sub INSERISCI_CARTELLA_IMMAGINI()
Application.Goto (ActiveWorkbook.Sheets("Parametri").Range("B3"))
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
ActiveCell.Value = .SelectedItems.Item(1) 'QUI IL DEBUG MI DA ERRORE
End With
End Sub

Dove sbaglio?
Grazie
Ciao ciao

[Anthony47]

Non so se ancora pendente, nel caso che Si allora la cosa piu' probabile e' che non sia stata fatta nessuna scelta per cui Item(1) non esiste.
Una versione piu' ortodossa per il tuo codice potrebbe essee questo:

Codice: Seleziona tutto

Sub INSERISCI_CARTELLA_IMMAGINI()
Application.Goto (ActiveWorkbook.Sheets("Parametri").Range("B3"))
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then
         MsgBox ("Nessuna voce selezionata, procedura annullata")
         GoTo Esci
         End If
ActiveCell.Value = .SelectedItems.Item(1)
End With
Esci:
End Sub


In questo modo se non e' stata fatta una scelta la macro termina con messaggio.

Ciao