[Excel 2013] Inserimento Immagini

[saxas]

Salve
devo realizzare una sorta di catalogo con delle foto dove a secondo dell'articolo presente nella colonna C dovrei inserire un immagine nella colonna E
Vorrei inserire le immagini con estensione JPG all'interno di una cartella, ed all'attivazione della macro a secondo dell'articolo presente nella colonna C mi prelevi l'immagine con lo stesso codice all'interno della cartella immagini.
Mi potete aiutare con una macro che possa farlo?
Non ho trovato nulla all'interno del forum, ma potrebbe anche essermi sfuggito non facendo una ricerca corretta.
Grazie

[ricky53]

Ciao,
le immagini dovranno essere adattate alla larghezza/altezza delle celle?
Io penso ... di Si!
Confermi ?

Il "Doppio Click" su una cella della colonna "C" potrebbe innescare l'evento di "copia della immagine" ma ...
Con il registratore di macro esegui le operazioni che hai descritto ed invia il codice ottenuto ... ci lavoreremo su.

[saxas]

- la dimensione delle celle sono Altezza 75 Larghezza 30, le immagini non hanno necessità di una particolare risoluzione, ma solo che entrino nella cella.
- senza doppio click, inserisco il codice, e poi lancio la macro

ho trovato una discussione precedente, ma non riesco a scaricare il file di esempio che avevi postato, hai modo di ripostarlo?
http://www.pc-facile.com/forum/viewtopic.php?f=26&t=101088&hilit=inserimento+immagini

Grazie

[ricky53]

Ciao,
non c'era alcun file.

In quella discussione leggi quanto riportato nel mio intervento fatto il "24/01/14" alle ore "02:19" e poi quanto ho scritto il "24/01/14" alle ore "18:09"

Per tutti riporto il codice

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim UR As Long, R As Long, I As Long, mPath As String, mFoto As String
    Dim oOgg As Shape, SH As Sheets
    If Target.Columns.Count > 1 Or Target.Rows.Count > 1 Then
        MsgBox "Operare solo su una cella"
        Exit Sub
    End If
    If Target <> "" Then
        UR = Range("A" & Rows.Count).End(xlUp).Row ' Ultima riga con dati
        If Not Intersect(Target, Range("A2:A" & UR)) Is Nothing Then
            mPath = "D:\Temp" ' <<===== QUI scrivi il percorso ove hai le tue foto
            mFoto = Target
            If Dir(mPath & "\" & mFoto & ".jpg") <> "" Then ' Si controlla se la foto esiste
                Application.ScreenUpdating = False
                For Each oOgg In ActiveSheet.Shapes
                    If oOgg.Top - 4.5 = Target.Top Then
                        oOgg.Delete ' Si cancella l'immagine esistente
                        Exit For
                    End If
                Next oOgg
                With ActiveSheet.Pictures.Insert(mPath & "\" & mFoto & ".jpg")
                    .Top = Target.Offset(0, 1).Top + 5
                    .Left = Target.Offset(0, 1).Left + 5
                    .Height = Target.Offset(0, 1).Height - 10
                    .Width = Target.Offset(0, 1).Width - 10
                End With
                Application.ScreenUpdating = True
            Else
                MsgBox "Immagine non trovata" ' <<====== QUI scrivi il messaggio che vuoi sia inviato
            End If
        Else
            MsgBox "Scrivere un nome in una cella della colonna  'A'"
        End If
    Else
        For Each oOgg In ActiveSheet.Shapes
            If oOgg.Top - 4.5 = Target.Top Then
                oOgg.Delete ' Si cancella l'immagine esistente
                Exit For
            End If
        Next oOgg
    End If
End Sub


Provala su un file nuovo e ... poi va adattata alle tue esigenze !

[saxas]

Ciao,
più tardi provo il codice che hai postato,
in ogni nel tuo intervento "24/01/14 23:25" scrivi esattamente

Ciao Antonella,
è venerdì ed ho tempo ... ecco un FILE di ESEMPIO.
Dovrai cambiare il percorso ... leggi i commenti che ho scritto nel codice.


Nel file ho già inserito delle immagini, posizionati sulla cella "A2" e premi "Canc" oltre che il nome verrà cancellata anche l'immagine presente in "B2", procedi con le altre immagini cancellando i nome, sempre in colonna "A".

Inserisci un nome di un fiore in "A2" e ...

mi riferivo a quel file
grazie per l'aiuto.

[ricky53]

Ciao,
vero l'avevo inserito ma era un file temporaneo.

Cercando ho reperito quest'altro che potrebbe esserti utile
Il file allegatro utilizza la "Convalida" per scegliere una immagine ... prova e fatti sentire

[ricky53]

Ciao,
l'esempio precedente va adattato ... MOLTO. Diciamo che è un altro caso ... magari anche utile per altre tue necessità


Adesso ho ricostruito un File di Esempio prendendo spunto dalla macro già inviata nel mio intervento del giorno "11/01/15" alle ore "23:28" ... PROVALO e sentiamoci per gli adattamenti in caso tu non riesca a farli in autonomia

[saxas]

Intanto ti ringrazio tantissimo, entrambe sono delle ottime soluzioni.
al momento è di mio interesse la macro che mi hai proposto all'inizio, e nel "File di Esempio"
il problema che mi si pone è che ho impostato l'altezza a 75 ed alcune foto sbordano dalla cella nella riga successiva,
inoltre altro problema è che se erroneamente cambio il nome della foto, inserisce la nuova immagine ma non elimina la precedente inserita, lasciandola al di sotto della nuova foto, così anche se cancello tutte le voci presenti nella colonna A

[ricky53]

Ciao,
"75" (ossia 100 pixel) è l'altezza delle righe?
La larghezza è ?

Potrebbe dipendere dal fatto che la dimensione delle immagini non corrisponda a quella delle celle e, quindi, provoca anche la "mancata cancellazione" delle precedenti immagini ...

DOMANDA: se carichi una tua immagine nel mio file excel cosa ottieni?


Puoi inviare un file "ZIP" contenente:
un file excel di esempio
delle immagini esterne al file excel

In questo modo potremmo provare sulla tua reale situazione e non costruirci una simulazione del tuo ambiente di lavoro.

[saxas]

Eccoti il link al file,
http://we.tl/eircpfXCbU
le immagini hanno varie dimensioni, così come sono quelle che dovrò utilizzare.

[Anthony47]

Il mio suggerimento era (viewtopic.php?f=26&t=101088#p584307) e rimane quello di assegnare un nome convenzionale alle immagini quando vengono inserite e cancellarle (usando lo stesso nome convenzionale) quando ne va inserita una nuova.
Cancellazioni in base alla posizione si prestano a facili errori.

Altra considerazione: le immagini e' accettabile che vengano distorte o devono rimanere "proporzionate"? Questo determina le modalita' di resizing da adottare.
E infine il file Excel prodotto deve essere distribuito a piu' utenti o rimane installato su un unico Pc? Nella prima ipotesi potrebbe essere uno spunto questa discussione: viewtopic.php?t=101422#p586823

Ciao

[saxas]

Si vista la tua soluzione e funziona perfettamente, infatti cambiando il nome inserito nella colonna A la nuova foto sostituisce la precedente.
La foto in ogni caso dovrebbe rimanere proporzionata, all'interno dell'altezza riga preimpostata.
E no per il momento il file excel rimane in un unico PC e non credo che avrò una esigenza diversa (il topic al link proposto è un buono spunto ma mi son perso fra le varie modifiche da fare, oltre che alle varie soluzioni per le diverse versioni di excel)
Grazie

[ricky53]

Ciao,
i problemi che hai segnalato si verificano con la versione di Office 2010 e 2013.

Ho provato con la versione 2003 e non ho problemi avuto alcun problema, sia nell'inserimento sia nella cancellazione.

L'unico problema è il "ridimensionamento" delle foto per inserirle nelle celle che per le foto troppo "alte" provoca una deformazione.

[Anthony47]

Il motivo per cui l' immagine si deforma e' la Proprieta' "LockAspectRatio" evidentemente impostata su False sul Pc di Saxas, mentre probabilmente risulta impostata su True su quello di Ricky (che pertanto non rileva lo stesso comportamento).

Quindi il mio suggerimento e' di impostare esplicitamente questa proprieta' su True e poi lasciare il solo ridimensionamento in Altezza dell' immagine (perche' stia nella riga; mentre se si "allarga" sulla colonna accanto potrebbe essere veniale).
Non so quale e' la macro corrente quindi non so tradurre in istruzioni quanto detto.

Il secondo link che avevo dato avrebbe una utilita' solo se devi distribuire il file ad altri utenti, perche' a partire da XL2010 il metodo Insert crea un link all' immagine (che quindi non viene integrata nel file Excel); non essendo questo il tuo caso puoi tralasciarlo.

Ciao

[saxas]

Il codice che sto utilizzando è il questo in pratico quello che è stato suggerito da Anthony dato che come specificavo nel post precedente mi cancella le immagini nel momento in cui le cambio, e non sovrapponendole come mi succedeva con i codice postato da richy

La Proprieta' "LockAspectRatio" come la dovrei modificare?

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 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
                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
                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

[Anthony47]

Prova questa variante di Sub Worksheet_Change:

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 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
                    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

Ho eliminato il ridimensionamento originale dell' immagine inserendolo in un secondo gruppo di istruzioni; la riga marcata *** serve ad applicare una larghezza inferiore a quella della cella che conterra' l' immagine; sulle immagini "piu' larghe che alte" questo portera' l' altezza ad ulteriormente ridursi rispetto all' altezza della cella. Se la larghezza non e' fondamentale (cioe' se si puo' invadere la cella a destra senza che cio' causi problemi), tale riga puo' essere eliminata.

Ciao

[saxas]

Sembra funzionare perfettamente rimettendo le due righe con "On Error" attive dato che l'ultima tua soluzione mi dava errore di debug nella riga ActiveSheet.Shapes

Codice: Seleziona tutto

   
For Each Cella In Target
       On Error Resume Next
            ActiveSheet.Shapes("FOTO_DA_" & Cella.Address(0, 0)).Delete
      On Error GoTo 0


Grazie ad entrambe

[saxas]

Ho modificato un pò il file di raccolta dati, facendo in modo che nella colonna B vengano inserite in automatico tutte le voci relative ai nomi delle foto presenti nella cartella TempFoto, e nella colonna F dovranno essere inserite le foto, e fin qui tutto bene.
Mi è nato un problema quando ho fatto in modo di creare una ulteriore macro per poter popolare il foglio di raccolta dati.
In pratica quando lancio la macro che inserisce i dati nel foglio di raccolta dati, la macro precedentemente discussa e perfettamente funzionante, inizia a controllare ogni cella che viene popolata non limitandosi alla sola colonna B, ho cercato di modificarla e inserirla in un modulo per poi farla partire successivamente ma mi da alcuni errori di debug su diverse istruzioni, fra cui il fatto che non trova la foto, mentre inserendo i nomi manualmente li trova normalmente.
C'è la possibilità di modificarla ulteriormente?
spero di essere stato chiaro, grazie per la disponibilità.

[Anthony47]

(Avevi fatto bene a ripristinare On Error, che avevo eliminato temporaneamente durante il collaudo)

Quanto al nuovo problema, prova a sostituire For Each Cella In Target con

Codice: Seleziona tutto

For Each Cella In Application.Intersect(Range(myArea), Target)

Ciao

[saxas]

Adesso funziona quasi alla perfezione,
nonostante myArea parta da A2 mi controlla anche l'inserimento che avviene in A1, cioè la riga di intestazione.

Codice: Seleziona tutto

    myArea = "A2:A" & EndRow    '<< Le celle dove potrai scrivere nomi immagini

Quando non trova un immagine mi restituisce il msgbox per ogni foto non trovata, si può fare in modo che restituisca solo una lista totale delle foto non trovate?
grazie ancora