EXCEL Cerca e inserisce immagine

[Francesco53]

Buon giorno a tutto il Forum,
in un foglio excel ho l'elenco delle squadre di calcetto e sulla destra l'immagine del gagliardetto della squadra,
la mia richesta è questa:
Quando predispongo le partite, vorrei che digitando il nome, mi ricercasse l'immagine del gagliardetto delle varie squadre. Pertanto se nella cella A3 digito Italia, nella cella B3 dovrebbe inserire l'immagine, come avviene per il Cerca.Vert. Sperando nell'aiuto per quanto richiesto, un saluto a tutti.
Francesco

[Anthony47]

Guarda questa discussione: viewtopic.php?f=26&t=66589
Sono descritti due metodi, uno basato sulla posizione delle immagini e uno basato su un elenco di nomi di immagini, e varie combinazioni tra i due metodi.
Probabilmente il metodo piu' semplice e' il secondo:
-ti crei una tabella con nome squadra e nome della relativa immagine
-con Cerca.vert trovi, in questo elenco, il nome dell' immagine
-con la macro rendi visibile quell' immagine
Le immagini devono essere gia' integrate nel foglio e rese "non visibili"; e' anche descritta la possibilita' che le immagini siano su disco, ma l' elenco deve descrivere il path completo e il nome dell' immagine.
E' una discussione un po' lunga, ma credo dia molti spunti per il tuo argomento.

Prova e fai sapere, ciao.

[Francesco53]

Grazie Anthony, ma non ciò capito molto causa la mia difficoltà nel capire
il post suggerito.
Francesco

[Anthony47]

Eh, devi insistere concentrandoti sul messaggio di fiorella.fortunato:
Comunque il concetto e':
-inserisci nel foglio tutte le immagini che ti servono, nella posizione che ti servono (quindi probabilmente sovrapposte)
-man mano che le inserisci prendi nota del nome immagine (vedi immagine) e della squadra a cui si riferiscono


Uploaded with ImageShack.us
-ti fai una tabella come descritta (la col B non ti serve e la lasci vuota), magari su Foglio2
-poi in D33 di foglio1 (quello su cui lavori) metti la formula

Codice: Seleziona tutto

=CERCA.VERT(A3;Foglio2!A1:C100;3)

-tasto dx sul tab col nome foglio, scegli Visualizza codice, copi la macro di fiorella e la incolli nel frame di dx
-poi torni su excel, inserisci in A3 il nome della squadra e vedi l' effetto sulle immagini.

Ciao

[Francesco53]

Grazie Anthony.
Francesco

[scanacc]

Carissimo Antony, ho seguito il metodo da te indicato ed ho messo il codice da te suggerito inserendo anche alcune variabili per automatizzare la comparsa della immagine

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "A2" Then
        Call ImmAle
    End If
End Sub
Sub ImmAle()
'
FoglioTab = "Foglio1"     '<<  Inserire Nome corretto del foglio Dati
FoglioOut = "Foglio2"     '<<  Inserire Nome corretto del foglio di out
CellaPos = "F1"           '<<  Inserire indirizzo cella con CONFRONTA
'
'Cancella le immagini presenti sul foglio di output
Application.EnableEvents = False
Sheets(FoglioOut).Activate
For Each Pict In ActiveSheet.Shapes
Pict.Delete
Next Pict
'
'Cerca l’ immagine ….
RigaNum = Range("F1").Value
Sheets(FoglioTab).Activate
CurPos = Range("B" & RigaNum).Address
For Each Pict In ActiveSheet.Shapes
  If Pict.TopLeftCell.Address = CurPos Then
  NomeImm = Pict.Name: Exit For
  End If
Next Pict
'      …. e copiala su foglio di output
Sheets(FoglioOut).Activate
If NomeImm = "" Then
MsgBox ("Nessuna Immagine corrisponde")
GoTo Uscita
End If
Sheets(FoglioTab).Shapes(NomeImm).Copy
Range("B2").Select    '<< Inserire Cella dove si vuole piazzare l’ immagine
ActiveSheet.Paste
    Sheets("Foglio2").Select
    Range("A2").Select
Uscita:
Application.EnableEvents = True
End Sub


Nel foglio1 ho inserito 2 sole immagini precedute dal nome (1 e 2). Inserendo nella cella A2 del foglio2 il loro nome (1 o 2) visualizzo correttamente in B2 l'immagine corrispondente.
Come potrei evitare il debug quando inserisco un numero sbagliato?

[Anthony47]

Qualsiasi cosa che sia piu' vecchia di 5 giorni io l'ho dimenticata; nel caso specifico sono oltre 2400 gg.
Quindi dovresti partire descrivendo cosa vorresti fare e quale e' la struttura dei fogli che usi e a cui la macro si riferisce.
A quel punto qualche idea mi verra'...

Ti aspeeetto

[scanacc]

Certo Antony.
Allora:
L'intento è di fare un cerca verticale sulle immagini.
Ho fatto una ricerca nel forum ed ho trovato questa pagina che mi è servita tantissimo tanto che sono riuscito a sfruttare appieno i tuoi consigli.
I metodi proposti erano due ma ho trovato più confacenti al mio caso i consigli da te proposti.
Quindi come da te a suo tempo suggerito, nel foglio1 ho inserito la tabella input. In pratica in A1 ed A2 ho messo il NOME delle immagini (in verità ho messo due numeri ... 1 e 2 )ed in B1 e B2 le IMMAGINI corrispondenti.
Nel foglio2 invece ho:
in F1 inserito la seguente formula

Codice: Seleziona tutto

=CONFRONTA(A2;Foglio1!A:A;0)

e dopo aver fatto tasto destro su Foglio2 (in visualizza codice) ho inserito la seguente macro

Codice: Seleziona tutto

Sub ImmAle()
'
FoglioTab = "Foglio1"     '<<  Inserire Nome corretto del foglio Dati
FoglioOut = "Foglio2"     '<<  Inserire Nome corretto del foglio di out
CellaPos = "F1"           '<<  Inserire indirizzo cella con CONFRONTA
'
'Cancella le immagini presenti sul foglio di output
Application.EnableEvents = False
Sheets(FoglioOut).Activate
For Each Pict In ActiveSheet.Shapes
Pict.Delete
Next Pict
'
'Cerca l’ immagine ….
RigaNum = Range("F1").Value
Sheets(FoglioTab).Activate
CurPos = Range("B" & RigaNum).Address
For Each Pict In ActiveSheet.Shapes
  If Pict.TopLeftCell.Address = CurPos Then
  NomeImm = Pict.Name: Exit For
  End If
Next Pict
'      …. e copiala su foglio di output
Sheets(FoglioOut).Activate
If NomeImm = "" Then
MsgBox ("Nessuna Immagine corrisponde")
GoTo Uscita
End If
Sheets(FoglioTab).Shapes(NomeImm).Copy
Range("B2").Select    '<< Inserire Cella dove si vuole piazzare l’ immagine
ActiveSheet.Paste

Uscita:
Application.EnableEvents = True
End Sub


Dopo di che tutto funziona perfettamente.
Quando nel Foglio2 cella A2 inserisco 1 o 2, nel Foglio2 della cella B2 compare l'immagine corrispondente.
Fin qui tutto OK.
Quello che però vorrei evitare è il debug che si presenta nel caso in cui nel Foglio2 cella A2 inserisco per errore un NOME che non è presente nel foglio di input.
In poche parole se sbaglio ad inserire il NOME (1 o 2) da ricercare (inserendo per esempio 3), come faccio ad evitare il debug?
Spero di essere stato chiaro.
Salutoni

[ricky53]

Ciao,
su quale istruzione ottieni l'errore?


. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
Attenzione: nel codice imposti la variabile "CellaPos" che poi non viene utilizzata.

Consiglio: definisci SEMPRE le variabili che utilizzi ed utilizza l'istruzione "option Explicit", che va posta, nel modulo, prima di tutte le macro.

[ricky53]

Ciao,
prima leggi il mio intervento precedente.

Prova a cambiare la formula in "F1" sostituendola con questa

Codice: Seleziona tutto

=SE(VAL.NON.DISP(CONFRONTA(A2;Foglio1!A:A;0)); "Immagine NON presente"; CONFRONTA(A2;Foglio1!A:A;0))

che ti avvisa se hai scritto un nome immagine che non esiste.


Io modificherei anche il codice nel modo seguente:

Codice: Seleziona tutto

Option Explicit ' <<=== Inserita

Sub ImmAle()
    Dim FoglioTab, FoglioOut, CellaPos, Pict, RigaNum, CurPos, NomeImm ' <<=== Inserita

    FoglioTab = "Foglio1"     '<<  Inserire Nome corretto del foglio Dati
    FoglioOut = "Foglio2"     '<<  Inserire Nome corretto del foglio di out
    CellaPos = "F1"           '<<  Inserire indirizzo cella con CONFRONTA
'
'Cancella le immagini presenti sul foglio di output
    Application.EnableEvents = False
    Sheets(FoglioOut).Activate
    For Each Pict In ActiveSheet.Shapes
        Pict.Delete
    Next Pict
'
'Cerca l’ immagine ….
    RigaNum = Range(CellaPos).Value ' <<==== Modificata
    Sheets(FoglioTab).Activate
    On Error GoTo Errore:
    CurPos = Range("B" & RigaNum).Address ' <<=== Inserita
    For Each Pict In ActiveSheet.Shapes
        If Pict.TopLeftCell.Address = CurPos Then
            NomeImm = Pict.Name: Exit For
        End If
    Next Pict
'      …. e copiala su foglio di output
    Sheets(FoglioOut).Activate
    If NomeImm = "" Then
        MsgBox ("Nessuna Immagine corrisponde")
        GoTo Uscita
    End If
    Sheets(FoglioTab).Shapes(NomeImm).Copy
    Range("B2").Select    '<< Inserire Cella dove si vuole piazzare l’ immagine
    ActiveSheet.Paste
    Range("A2").Select
Uscita:
    Application.EnableEvents = True
    Exit Sub

Errore: ' <<=== Inserita
    MsgBox "L'immagine non è presente", vbCritical ' <<=== Inserita

End Sub


[scanacc]

Funziona. Il debug, non si ripresenta ... ma ho notato una cosa strana.
Ho inserito ad inizio macro un comando per fare in modo che la macro inizi quando si varia il numero nella cella A2 del foglio A2:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address(0, 0) = "A2" Then
        Call ImmAle
    End If
End Sub

Questo comando, una volta sbagliato il numero inserito e quindi dopo essere stato visualizzato il messaggio, non funziona più automaticamente ma per farlo funzionare devo far partire manualmente la macro.
Sapete perchè e come potrei fare per...?

[ricky53]

Ciao,
sostituisci
con

Codice: Seleziona tutto

Errore:
    MsgBox "L'immagine non è presente", vbCritical
End Sub


con

Codice: Seleziona tutto

Errore:
    MsgBox "L'immagine non è presente", vbCritical
    GoTo Uscita ' <<=== Inserita
End Sub


Mancava la riattivazione degli eventi che era stata disattivata prima quando vengono cancellate le immagini presenti nel foglio


Ecco il codice completo, ottimizzato e ripulito di commenti non necessari

Codice: Seleziona tutto

Option Explicit

Sub ImmAle()
    Dim FoglioTab, FoglioOut, CellaPos, Pict, RigaNum, CurPos, NomeImm

    FoglioTab = "Foglio1"     '<<  Inserire Nome corretto del foglio Dati
    FoglioOut = "Foglio2"     '<<  Inserire Nome corretto del foglio di out
    CellaPos = "F1"           '<<  Inserire indirizzo cella con CONFRONTA
'
'Cancella le immagini presenti sul foglio di output
    Application.EnableEvents = False
    Sheets(FoglioOut).Activate
    For Each Pict In ActiveSheet.Shapes
        Pict.Delete
    Next Pict
'
'Cerca l’ immagine ….
    RigaNum = Range(CellaPos).Value
    Sheets(FoglioTab).Activate
    On Error GoTo Errore:
    CurPos = Range("B" & RigaNum).Address
    For Each Pict In ActiveSheet.Shapes
        If Pict.TopLeftCell.Address = CurPos Then
            NomeImm = Pict.Name: Exit For
        End If
    Next Pict
'      …. e copiala su foglio di output
    Sheets(FoglioOut).Activate
    If NomeImm = "" Then
        MsgBox ("Nessuna Immagine corrisponde")
        GoTo Uscita
    End If
    Sheets(FoglioTab).Shapes(NomeImm).Copy
    Range("B2").Select    '<< Inserire Cella dove si vuole piazzare l’ immagine
    ActiveSheet.Paste
    Range("A2").Select
    GoTo Uscita

Errore:
    Sheets(FoglioOut).Activate
    Range("A2").Select
    MsgBox "L'immagine non è presente", vbCritical
Uscita:
    Application.EnableEvents = True
End Sub