Condividi:        

Cerca ed inserisci più IMMAGINI su Excel

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Cerca ed inserisci più IMMAGINI su Excel

Postdi scanacc » 15/03/18 11:57

Caro Antony e cari tutti.
Allora:
L'intento è di fare un cerca verticale sulle immagini. ed inserirle nella casella voluta.
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
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.
In realtà però devo fare in modo che anche nella cella B3 (fino alla B70) compaia l'immagine corrispondente alla ricerca voluta (dalla cella A3 alla cella A70).
Praticamente vorrei, dopo aver messo i nomi delle immagini nelle celle che vanno da A2 a A70 (nel foglio1), ed aver inserito le immagini corrispondenti da B2 a B70 (sempre nel foglio1) fare in modo, dopo aver selezionato la macro, che nel foglio2, a fianco delle richieste di ricerca fatte da A2 a A70 compaiano le immagini corrispondenti nelle celle che vanno da B2 a B70 (sempre del foglio2)
Spero di essermi spiegato bene.
Aiutoooooooooo
Grazie per la tua/vostra attenzione
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Sponsor
 

Re: Cerca ed inserisci più IMMAGINI su Excel

Postdi Anthony47 » 16/03/18 01:50

Senza un file di prova posso solo suggerire di inserire in un ciclo la ricerca e copia dell'immagine:
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
'
Application.ScreenUpdating = False      '+++
For i = 2 To 70                         '+++
    'Cerca l’ immagine ….
    RigaNum = Cells(i, "A").Value       'MMM
    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
        noImm = noImm & RigaNum & " " & vbCrLf    'MMM
    End If
    If NomeImm <> "" Then Sheets(FoglioTab).Shapes(NomeImm).Copy    'MMM
    Cells(i, "B").Select   '                                        'MMM
    If NomeImm <> "" Then ActiveSheet.Paste                         'MMM
Next i                                  '+++
Application.ScreenUpdating = True       '+++
'
uscita:
Application.EnableEvents = True
If Len(noImm) > 2 Then                  '+++ Blocco intero
    MsgBox ("Completato con errori su linee " & vbCrLf & noImm)
Else
    MsgBox ("Completato...")
End If
End Sub
Le istruzioni aggiunte sono marcate +++, quelle modificate MMM

Sara' poco efficiente ma dovrebbe funzionare

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Cerca ed inserisci più IMMAGINI su Excel

Postdi scanacc » 16/03/18 14:11

La prima prova è riuscita benissimo!
Perfetto come sempre
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Re: Cerca ed inserisci più IMMAGINI su Excel

Postdi scanacc » 16/03/18 17:02

Una domanda Antony, ho visto che l'immagine si posizionano in alto a destra delle celle. Quale comando dovrei aggiungere affinchè si posizioni nel centri delle varie celle?
scanacc
Utente Senior
 
Post: 350
Iscritto il: 06/12/15 10:30

Re: Cerca ed inserisci più IMMAGINI su Excel

Postdi Anthony47 » 17/03/18 00:09

Non so che cosa intendi per posizionere "nel centro delle varie celle"; se alludi all'angolo in alto a sx dell'immagine allora devi impostare il .Top e il .Left come segue:
1) elimina If NomeImm <> "" Then ActiveSheet.Paste 'MMM
2) al suo posto inserisci
Codice: Seleziona tutto
    If nomeImm <> "" Then
        ActiveSheet.Paste                         '
        Selection.ShapeRange.Left = Cells(i, "B").Left + Cells(i, "B").Width / 2   '<<<++
        Selection.ShapeRange.Top = Cells(i, "B").Top+ Cells(i, "B").Height / 2     '<<<++
    End If

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Cerca ed inserisci più IMMAGINI su Excel":


Chi c’è in linea

Visitano il forum: Marius44, Ricky0185 e 47 ospiti