Immagine visibile e in posizione definita

[BG66]

Ciao a tutti.
Premetto che sono a conoscenza che le celle unite sono poco gestibili ma il format dell'etichetta è purtroppo questo.

Quello che ho fatto:
Macro che fa comparire immagine quando in C2 è presente esclusivamente l'asterisco.
L'immagine si posiziona a lato della cella C2 con dimensione insufficiente.

Quello che avrei bisogno di fare:
Macro che fa comparire immagine quando in C2 è presente l'asterisco all'interno di un testo composito (es. 07 02 04 * )
L'immagine si posiziona al centro della colonna D4:D9 comprendo la scritta "etichetta NON PREVISTA"
https://www.swisstransfer.com/d/f5d60a91-ceb2-4339-b405-69bf5f45eaf4

Grazie per l'aiuto.

Gene

[Marius44]

Ciao Gene
Modifica quetsa parte di codice così (per la posizione e la larghezza)

Codice: Seleziona tutto

....
        For Each rCell In Rng.Cells
            With Me.Shapes(arrImagini(i))
              .Visible = CStr(rCell.Value) = arrValori(i)
              .Top = rCell.Offset(2, 0).Top
              .Left = rCell.Left + rCell.Width
              .Width = Range("D1").Width
              .Height = Range("D4:D9").Height
            End With
            i = i + 1
        Next rCell
....


Se ti va bene vedremo poi per il resto. Spiegami una cosa: perchè alla fine delle due date c'è uno spazio, sia dopo l'asterisco sia senza l'asterisco?
Ciao,
Mario

[Anthony47]

La descrizione e’ molto povera, e l’attuale macro e’ sovradimensionata per quanto ci hai detto: forse e’ un anticipo di un adattamento che dovrai fare, o forse e’ il superfluo da un adattamento gia’ fatto parzialmente.
Con questi dubbi lascio anche io il codice surdimensionato ma mi permetto di correggere parte del codice di Mario, perché ha trascurato parti importanti della richiesta (so che non si offenderà ). Il mio adattamento:

Codice: Seleziona tutto

            With Me.Shapes(arrImagini(i))
                .Visible = InStr(1, rCell.Value & "   ", arrValori(i), vbTextCompare) > 0
                .Top = Range("D4").Top
                .Left = Range("D4").Left - .Width / 2 + Range("D4").Width / 2
                .Height = Range("D4:D9").Height
            End With


Ciao a tutti

[Marius44]

Ciao
Come al solito, si vede la "mano" del Maestro.
Non posso offendermi se migliori il codice ma, aggiungo, che avevo detto che non era completo. Mi hai solo anticipato.
Ciao,
Mario

[BG66]

Ciao Mario,
in realtà è un codice CER (Codici Europei di Rifiuti). Li ho importati da un sito istituzionale e non mi ero accordo della presenza di uno spazio.

Ciao Anthony,
meglio abbondare che deficere

Grazie ad entrambi. Domani pomeriggio faccio qualche prova e poi vi aggiorno.

Intanto un buona serata ad entrambi.

Gene
PS Siete mitici!!

[Anthony47]

Come al solito, si vede la "mano" del Maestro

A volte mi sembro piu' il pistillo che vuole sempre dire la sua...

Speriamo che funzioni, cosa che puo' dire solo Gene

Buona giornata a tutti

[BG66]

Ciao a tutti.
Non ho resistito e mentre sono in un webinar ho comunque fatto la prova ed.... ovviamente funziona.
https://www.swisstransfer.com/d/8a35a9d7-d1b6-4d80-bd96-2aedaef5a61a

Mentre a questo punto rivelo anche il perchè di una struttura macro "pesante".
In pratica pensavo di modificare:

Codice: Seleziona tutto

Const sIntervallo As String = "C2"   'C10,C13,C16;C19             '<<=== Modifica
    Const sImagini As String = "Immagine 1" 'esempio HP_4,HP_5,hp_6   '<<=== Modifica
    Const sValori As String = "*"       'esempio HP 4,HP 5, HP 6      '<<=== Modifica

per richiamare delle altre immagini rispetto all'input nella cella specifica (C10,C13,C16;C19) e presenti nella colonna D nel foglio di lavoro "Codici HP".

...ma non ci sono riuscito.

Grazie per la pazienza e l'aiuto.
Gene

[Anthony47]

Da quello che vedo, devi solo modificare l'istruzione che assegna il Left all'immagine, giocando con Offset; dovrebbe quindi bastare

Codice: Seleziona tutto

                .Left = rCell.Offset(2, 1).Offset(0, -1).Left - .Width / 2 + rCell.Offset(2, 1).Offset(0, -1).Width / 2


Ovviamente sIntervallo deve contenere l'elenco delle varie celle e sImagini il nome delle corrispondenti immagini, così come sono conosciute da Excel (non come si chiamavano in origine prima di essere inserite nel foglio

[BG66]

Ciao Anthony,
non credo di aver applicato correttamente il tuo consiglio perché non ottengo nessun risultato.
Si "illiumina" : With Me.Shapes(arrImagini(i))

https://www.swisstransfer.com/d/669e359a-d187-4ceb-a93a-838d80ac48e3

Mi guardi dove sto sbagliando?

Grazie
Gene

[Anthony47]

Non ho capito come dovrebbe funzionare il foglio che hai condiviso, ce lo spieghi?

[BG66]

Ciao.
Faccio un esempio sperando di essere più chiaro possibile:
Parto selezionando nella cella C2 un Codice CER. Nel ns. caso è il 07 02 04 *
la presenza dell'asterisco rende obbligatorio l'inserimento nell'etichetta dell'immagine con la R
-> risolto con l'integrazione MACRO che tu hai fatto.

Ora passiamo alla seconda fase.
Grazie alla selezione del codice CER fatto in precedenza con vari INDICE/CONFRONTA vado a compilare:
la celle C10 con la classe di pericolo
e le altre celle (C13-C16-C19) se vi sono altre classi di pericolo.

Tornando al nostro esempio: il codice CER 07 02 04 * ha una sola classe (HP 4)
quindi in D10 dovrei far apparire l'immagine che ho nominato HP_4.

Nel caso ci fosse una seconda classe di pericolo questa andrebbe a popolare la cella C13 richiamando l'immagine specifica (HP_6,hp_8, etc) nella cella nella colonna D.
Tieni conto che al momento nessun codice CER ha più di 4 classe di pericolo ma potrebbe essere non pericoloso e quindi non averne nessuna.

Gene

[Anthony47]

Allora, in pratica, dobbiamo inserire una immagine in funzione del contenuto di C2. Poi, a seconda di quale contenuto viene visualizzato in C10, C13 etc, visualizzare in colonna D il relativo pittogramma, come definiti nel foglio “Codici HP”
Per questo voglio suggerirti un metodo alternativo...

A) Innanzitutto torna alla macro che visualizza correttamente l'immagine in D4
B) Poi:
1) Crea nel tuo file un “intervallo nominato”; come “Nome” gli assegni _C10 e come “Riferito a” inserisci la formula =SCARTO('Codici HP'!$D$1;SE.ERRORE(CONFRONTA(Etichetta!$C$10;'Codici HP'!$A$1:$A$100;0);17)-1;0)
2) In Etichetta!D10 inserisci una “Immagine”; va bene qualsiasi jpg che ti capita. Dimensionala sulla cella
3) Seleziona l’immagine, e nella barra della formula inserisci =_C10

Ora prova a cambiare il contenuto di C10, dovresti visualizzare l’immagine relativa. Se la classe di pericolo non esiste allora verra’ visualizzato il contenuto di Codici HP!D17, che nel tuo file e’ vuota (ma se ci scrivi PIPPO verrà visualizzato “PIPPO”)
Per non vedere il contorno, devi disabilitare la visualizzazione della griglia nel foglio Codici HP: Menu /Opzioni /Impostazioni avanzate; in Opzioni di visualizzazione del foglio, togliere la spunta a Griglia.


Ripeti il processo creando un intercallo col nome _C13, inserendo una nuova immagine in Etichetta!D13 cui assegnerai la formula =_C13

Ripeti per altri pittogrammi che vuoi visualizzare all’occorrenza

Prova...

[Marius44]

Salve a tutti

Come ha detto Gene, mi si blocca nel punto
Senza applicare quanto detto da @Anthony47 nel post precedente, ho elaborato la macro seguente (si nota meglio il lavoro scaricando il file che allego)

Codice: Seleziona tutto

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Not Intersect(Target, Range("C2")) Is Nothing Then
  Dim nc As Integer, i As Integer, j As Long, imag As String, alta As String
Application.EnableEvents = False
  'cancella immagini precedenti
  For i = Sheets("Etichetta").Shapes.Count To 1 Step -1 'Sheets("Etichetta").Shapes.Count
    If Left(Sheets("Etichetta").Shapes(i).Name, 3) = "Pic" Then
      Sheets("Etichetta").Shapes(i).Delete
    End If
  Next i
  nc = Len(Target) 'lunghezza della stringa
  For i = 1 To nc
    If nc > 1 And Mid(Target, i, 1) = "*" Then
      Sheets("Codici HP").Shapes("Immagine 1").Copy
      Sheets("Etichetta").Range("D4").PasteSpecial
      With Me.Shapes(Shapes.Count)
        .Top = Range("D4").Top
        .Left = Range("D4").Left
        .Height = Range("D4:D9").Height
        .Width = Columns("D").Width
      End With
      'seconda parte
      For j = 10 To 19 Step 3
        If Range("C" & j) <> "" Then
          imag = Range("C" & j).Text
          Sheets("Codici HP").Shapes(imag).Copy
          Sheets("Etichetta").Range("D" & j).PasteSpecial
          With Shapes(Shapes.Count)
            .Top = Range("D" & j).Top
            .Left = Range("D" & j).Left
            alta = "D" & j & ":D" & j + 2
            .Height = Range(alta).Height
            .Width = Columns("D").Width
          End With
        End If
      Next j
    End If
  Next i
End If
Application.EnableEvents = True
Cells(2, 5).Select
End Sub

Sub ripr()
Application.EnableEvents = True
End Sub


https://www.dropbox.com/scl/fi/bn48onab ... fvf1t&dl=0
La macro funziona (a patto che quanto scritto nelle celle corrisponda al nome dell'immagine) ma qualche volta si "impalla" - ecco il motivo della seconda macro)

Mi piacerebbe, anche se non è molto "professionale", che ci deste uno sguardo anche per correggere qualche mio errore di conoscenza.
Ringrazio in anticipo. Ciao,
Mario

[Anthony47]

Mario, ci sono delle particolarità che fanno fallire parte del tuo codice.
La piu’ subdola e’ che con Me.Shapes(Shapes.Count) non fai riferimento all’immagine appena incollata sul foglio, ma al DropDown della convalida; quindi falliscono tutte i tentativi di impostare posizione e dimensioni delle immagini che incolli.
Ma se usi With.Selection le operazioni verranno completate correttamente

La seconda e’ che le operazioni di ridimensionamento dipendono dal parametro LockAspectRatio, che se e' True modifica altezza e larghezza in proporzione; col risultato che quando imposti Width allora anche la Height si modifica e, nel caso specifico, l'immagine "straripa" nelle righe destinate all'immagine sottostante.
Da quel che ricordo, il parametro LockAspectRatio viene "memorizzato" nell'ultima impostazione, quindi in linea di massima e' aleatorio.
Per evitare questa situazione, ipotizzando che la misura vincolante sia l'altezza, basterebbe invertire le istruzioni .Width (prima) e .Height (dopo); volendo centrare rispetto alla cella, anche l'istruzione .Left dovrebbe essere spostata dopo la .Height
Oppure imposti (all’interno di With Selection) .LockAspectRatio=False in modo che Height e Width possano essere modificate indipendentemente.

Quanto agli "impallamenti" immagino che essi siano dovuti a situazioni in cui cerchi di copiare immagini inesistenti che portano facilmente all'abort della macro senza il relativo Application.EnableEvents = True finale. Potresti gestire la cosa tramite On Error GoTo EndMacro, con l'etichetta EndMacro posizionata subito prima della Application.EnableEvents = True

Come ulteriore curiosità, quell'Application.EnableEvents = True in testa alla sub e' ovviamente inutile

[Marius44]

Ciao Anthony
Innanzi tutto grazie per avermi dedicato il tuo tempo.
In ordine:
a) il primo Application.EnableEvents = True è, evidentemente, un refuso dopo le tante prove fatte.
b) Ero convinto (ma non ricordo dove ho letto qualcosa al riguardo) che Me.Shapes(Shapes.Count) si riferisse all'ultima immagine inserita (o, comunque, all'ultimo oggetto inserito). Devo darti atto che così non è (o, almeno, non sembra). Mi riprometto di approfondire perchè, forse, bisogna riferirsi al "numero" assegnato all'ultimo oggetto inserito.
c) non comprendo il riferimento a With Selection visto che non ho ancora selezionato nulla.

Ma quello che più mi dà dei grattacapo non idiffrenti è il fatto che TALVOLTA funziona e TAL'ALTRA no!!!!!
Devo studiarmi il problema per benino.
Ciao e ancora grazie,
Mario

[BG66]

Ciao a tutti.
Scusate il ritardo ma abbiamo trascorso un WE in montagna e fortunatamente il segnale è prossimo allo zero!!

x Anthony: Fatta prova e ...oltre ad imparare qualcosa di nuovo... ho ottenuto quello che mi serviva. Ovviamente un milione di grazie.

x Mario: Sei un grande, non molli mai e la tua voglia di metterti sempre in discussione è per me un esempio importantissimo.

Buona serata
Gene

[Anthony47]

Grazie Gene per il feedback

Ero convinto (ma non ricordo dove ho letto qualcosa al riguardo) che Me.Shapes(Shapes.Count) si riferisse all'ultima immagine inserita (o, comunque, all'ultimo oggetto inserito)

Anche io ho visto quasi sempre usare quel metodo, magari nelle vecchie versioni do Office funzionava bene; il problema nasce quando ci sono gia' altre shapes proprie del foglio di lavoro, quali sono appunto i dropdown box delle convalide

non comprendo il riferimento a With Selection visto che non ho ancora selezionato nulla

Dopo il PasteSpecial, l'immagine inserita risulta Selezionata

Ma quello che più mi dà dei grattacapo non idiffrenti è il fatto che TALVOLTA funziona e TAL'ALTRA no!!!!!

Incuriosito da questa affermazione ho creato un loop di test per simulare continue operazioni di inserisci e togli. E anche a me si e' manifestato un inghippo aleatorio, con runtime error -2147221040, tipicamente sulla .Copy dell'immagine, talvolta sulla .PasteSpecial; piu' su Immagine 1 che sulle altre

Google mi ha portato su vari post che ipotizzano un bug, oppure un problema di timing; questa seconda opzione e' la piu' plausibile, visto che quando si manifesta l'errore, usando F5 (continua la macro) l'operazione viene eseguita e la macro continua senza problemi.
Dopo qualche prova, posizionando un DoEvents nel codice le operazioni procedono in loop senza problemi.
La modifica:

Codice: Seleziona tutto

'. . .
  nc = Len(TArget) 'lunghezza della stringa
  DoEvents                  '++++
  For I = 1 To nc
'. . .


Vedi se anche a te risolve l'arcano...

[Marius44]

Buona serata a tutti.
Riepiloghiamo:
a) l'aggiunta del DoEvents è stato un toccasana;
b) .LockAspectRatio non mi viene accettato (non supportato dall'oggetto)
c) Non è necessario Application.EnableEvents = False/True
d) Le immagini vengono ingrandite per quante sono le righe (non per la colonna)
Compilata come appresso la macro funziona perfettamente

Codice: Seleziona tutto

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C2")) Is Nothing Then
  Dim nc As Integer, i As Integer, j As Long, imag As String, alta As String
  'cancella immagini precedenti
  For i = Sheets("Etichetta").Shapes.Count To 1 Step -1
    If Left(Sheets("Etichetta").Shapes(i).Name, 3) = "Pic" Then
      Sheets("Etichetta").Shapes(i).Delete
    End If
  Next i
  nc = Len(Target) 'lunghezza della stringa
  DoEvents         'aggiunta suggerita da Anthony
  For i = 1 To nc
    If nc > 1 And Mid(Target, i, 1) = "*" Then
      Sheets("Codici HP").Shapes("Immagine 1").Copy
      Sheets("Etichetta").Range("D4").PasteSpecial
      With Selection
        '.LockAspectRatio = False       '<<<<< non l'accetta
        .Left = Range("D4").Left
        .Top = Range("D4").Top
        .Width = Columns("D").Width
        .Height = Range("D4:D9").Height
      End With
      'seconda parte
      For j = 10 To 19 Step 3
        If Range("C" & j) <> "" Then
          imag = Range("C" & j).Text
          Sheets("Codici HP").Shapes(imag).Copy
          Sheets("Etichetta").Range("D" & j).PasteSpecial
          With Selection
            '.LockAspectRatio = False    '<<<<< non l'accetta
            .Left = Range("D" & j).Left
            .Top = Range("D" & j).Top
            .Width = Columns("D").Width
            alta = "D" & j & ":D" & j + 2
            .Height = Range(alta).Height
          End With
        End If
      Next j
    End If
  Next i
End If
Cells(1, 6).Select
End Sub


A questo punto, caro Gene, non ti resta che adeguare i codici con la scrittura dei vari codici di rischio per ogni dato e la ricerca delle relative immagini (non penso che vorrai scriverli a mano come hai fatto con l'esempio).
Ancora un caro saluto ad entrambi ed alla prossima,
Mario

[Anthony47]

Perdona, per impostare LockAspectRatio la sintassi deve essere

Codice: Seleziona tutto

          With Selection
            .ShapeRange.LockAspectRatio = False
            'etc etc


Con LockAspectRatio = False potrai manovrare a piacere si la Width che la Height, cioe' le immagini potranno risultare distorte

[Marius44]

Ciao
Come sempre, hai ragione. Grazie per avermelo fatto notare ma ieri sera ero troppo euforico per aver ottenuto, col tuo aiuto s'intende, il risultato voluto.

Ciao,
Mario