Condividi:        

1_Sovrapposizione immagini (di 3)

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

1_Sovrapposizione immagini (di 3)

Postdi BG66 » 14/12/19 07:35

Buongiorno a tutti.
Vorrei dare una sistemata a questo file, partirei da:
1) Quando, ad esempio, filtro le informazioni per PRODUTTORE i pittogrammi nelle colonne simbolo si sovrappongono:
Immagine

https://www.dropbox.com/s/yrnaa91iztz9pfq/lista%20prodotti%20chimici_FORUM.xls?dl=0

Gli altri due punti saranno:
2) La possibilità di leggere il testo completo delle varie frasi di rischio (colonna J) "prendendole" dalla lista presente nel foglio CLP
-> PS Sul punto 2, credo che dovrei creare una colonna singola per ogni frase di rischio ma questo per alcune sostanze renderebbe il file illeggibile all'operatore che in un colpo d'occhio deve/dovrebbe capire i pericoli immediati legati a quel prodotto.

3) Aggiornare i dati nel foglio "PRODOTTI CHIMICI & CO (2)" se già presenti nel foglio "PRODOTTI CHIMICI ATTIVI". Altrimenti permettermi l'inserimento.
-> Pensavo ad una userform che inserito il nome del prodotto vada a verificare se è già presente e riempe i campi altrimenti mi permette di inserire il nuovo prodotto.

Ovviamente nel frattempo continuo a provarci per cavarmela da solo.

Grazie per l'aiuto e per le dritte per permmettermi di proseguire con meno dubbi.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: 1_Sovrapposizione immagini (di 3)

Postdi Marius44 » 14/12/19 08:17

Ciao Gene

1° problema - clic-dx su ogni immagine - nella finestra che si apre Proprietà e seleziona "Sposta e ridimensiona con le celle"
Penso che sia quello che vuoi.

2° problema - potresti crearti una UserForm con dentro una Label ed inserire in quest'ultima la frase che vuoi badando di mettere la proprietà Autosize a True. La Userform potrebbe essere mostrata tramite l'Evento Worksheet_SeletionChange della colonna J del foglio Prodotti Chimici Attivi

3° problema - mi piacerebbe una spiegazione più dettagliata (non credo d'aver capito bene).

Ciao,
Mario
Marius44
Utente Senior
 
Post: 655
Iscritto il: 07/09/15 22:00

Re: 1_Sovrapposizione immagini (di 3)

Postdi Anthony47 » 14/12/19 16:11

Giustissimo il suggerimento di Mario; ma siccome noi non ci limitiamo a dare buoni consigli, questa macro ti aiutera' a riassegnare la proprieta' "Sposta e ridimensiona con le celle" a tutte le immagini che giacciono tra colonna C e colonna I:
Codice: Seleziona tutto
Sub BGShProp()
    Dim Sh As Shape
    For Each Sh In ActiveSheet.Shapes
        Debug.Print Sh.TopLeftCell.Address, Sh.Type
        If Sh.Type = msoPicture Then
            If Sh.TopLeftCell.Column > 2 And Sh.TopLeftCell.Column < 10 Then
                Sh.Placement = xlMoveAndSize
'Riposiziona shapes, vedi messaggio:
                Sh.LockAspectRatio = msoFalse
                Sh.Top = Sh.TopLeftCell.Top + 2
                Sh.Height = Sh.TopLeftCell.Height - 4
                Sh.Left = Sh.TopLeftCell.Left + 5
                Sh.Width = Sh.TopLeftCell.MergeArea.Width - 10
'end Riposiziona
            End If
        End If
    Next Sh
End Sub

Siccome le varie icone mi sembrano posizionate a mano, mi son permesso di aggiungere le istruzioni per posizionarle al centro delle aree a loro assegnate, vedi istruzioni marcate 'Riposiziona shapes

Non so se quest'ultima "prestazione" ti fa comodo o scomodo: prova l'effetto su una copia del tuo file; ti accorgerai cosi' che non tutte sono posizionate su celle unite (es quelle su foglio PRODOTTI CHIMICI & CO (2)) per cui ti potresti trovare con icone molto strette (ma se riesegui la Sub BGShProp dopo aver allargato le colonne o averle unite la dimensione si aggiusta di conseguenza)

Per il quesito 2, non conosco l'obiettivo complessivo quindi propongo "a braccia" di inserire sul foglio un TextBox che verra' usato per mostrare le frasi complete corrispondenti alle sigle presenti nella colonna J, popolandolo tramite una macro di Worksheet_SelectionChange.
Il codice della Worksheet_SelectionChange:
Codice: Seleziona tutto
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim CLPArr, mySplit, I As Long, J As Long, myMess As String, lCnt As Long
'
If Target.Column = 10 And Target.Count = 1 Then
    If Target.Value <> "" Then
        If IsEmpty(CLPArr) Then
            CLPArr = Foglio2.Range(Foglio2.Cells(1, 1), Foglio2.Cells(Rows.Count, 1).End(xlUp)).Value
        End If
        mySplit = Split("-" & Target.Value, "-", , vbTextCompare)
        For I = 0 To UBound(mySplit)
            If Len(Trim(mySplit(I))) > 0 Then
                For J = LBound(CLPArr) To UBound(CLPArr)
                    If InStr(1, CLPArr(J, 1), Trim(mySplit(I)), vbTextCompare) > 0 Then
                        myMess = myMess & CLPArr(J, 1) & vbCrLf
                        lCnt = lCnt + 1
                    End If
                Next J
            End If
        Next I
        If lCnt > 0 Then
            With Me.TextBox1
            .Text = myMess
            .Top = Target.Offset(1, 0).Top
            .Left = Target.Offset(1, 0).Left
            .Height = lCnt * 13 + 10
            .Visible = True
            End With
        Else
            Me.TextBox1.Visible = False
        End If
    Else
        Me.TextBox1.Visible = False
    End If
Else
    Me.TextBox1.Visible = False
End If
End Sub

L'ho inserita solo nel modulo vba del foglio PRODOTTI CHIMICI & CO (2); presuppone che il TextBox si chiami TextBox1 e sia un oggetto ActiveX (non Modulo).

Per il quesito3, la mia proposta e' che invece crei un fono "Anagrafica" delle sostanze, a da questo attingi sia per popolare il foglio PRODOTTI CHIMICI ATTIVI che il foglio PRODOTTI CHIMICI & CO (2)

Le proposte relative al quesito1 e quesito2 sono visibili nel file dimostrativo scaricabile da DROPBOX: https://www.dropbox.com/s/cf6qdu5g33kb8 ... 4.xls?dl=0

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

Re: 1_Sovrapposizione immagini (di 3)

Postdi BG66 » 15/12/19 06:40

Ciao a tutti.
inverto l'ordine delle risposte cosi da rendere più comprensibile questo punto:

Anthony47 ha scritto:Per il quesito3, la mia proposta e' che invece crei un fono "Anagrafica" delle sostanze, a da questo attingi sia per popolare il foglio PRODOTTI CHIMICI ATTIVI che il foglio PRODOTTI CHIMICI & CO (2)

-> FATTO. Anticipo che ho creato una macro per nascondere/proteggere il foglio (pw Pippo).
Ma come realizzo quanto sotto?

Marius44 ha scritto:3° problema - mi piacerebbe una spiegazione più dettagliata (non credo d'aver capito bene).

In pratica le condizioni sono tre:
a) Inserimento di una nuova sostanza in un solo foglio di lavoro oppure in entrambi
b) Eliminazione di una sostanza esistente in un solo foglio di lavoro oppure in entrambi
c) Aggiornamento dati presenti (in genere al ricevimento di una nuova scheda di sicurezza, aggiorno il link al PDF specifico [colonna B] e modifico a mano il n°della versione e la data di revisione [colonna J e K]

https://www.dropbox.com/s/35uuto7gy47gvgb/byBG66_lista%20prodotti%20chimici_FORUM_Ant01.xls?dl=0

Aggiungo che su questo punto mi stavo impelagando su una userform con tre optionbutton (INSERISCI - ELIMINA - AGGIORNA) era/ è la strada giusta??

Attendo vostre.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: 1_Sovrapposizione immagini (di 3)

Postdi Anthony47 » 18/12/19 01:15

Scusa, esigenze "di stagione" mi hanno tenuto lontano dal pc...

Avendo creato un foglio AnagraficaProdotti, quando vuoi inserire un prodotto su uno dei fogli ne copi le colonne A:N e le incolli nel foglio dove vuoi inserire questa voce.
Alternativamente, inserisci in colonna B dei fogli da popolare una Convalida da Elenco, con origine su colonna B di AnagraficaProdotti; poi aggiungi questa macro di WorkSheet_Change:
Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count = 1 Then
        If Target.Column = 2 And Target.Value <> "" Then
            Application.EnableEvents = False
            Target.Offset(0, -1).Select
            With Sheets("Anagrafica Prodotti")
                mymatch = Application.Match(Target.Value, .Range("B:B"), False)
                If Not IsError(mymatch) Then
                        Target.EntireRow.RowHeight = 31.20
                        .Cells(mymatch, 1).Resize(1, 15).Copy
                        ActiveSheet.Paste
                        Application.CutCopyMode = False
                End If
            End With
            Target.Select
            Application.EnableEvents = True
        End If
    End If
End Sub
In questo modo ti bastera' inserire il nome del prodotto in colonna B e la macro andra' a copiare da AnagraficaProdotti le colonne A:N incollandole nella riga.

Quando vuoi invece rimuovere un prodotto, ti bastera' selezionare la riga ed eliminarla; se vuoi farlo con l'evento doppioclick, inserisci questa macro di BeforeDoubleClick:
Codice: Seleziona tutto
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
If Target.Column = 1 Then
    Target.EntireRow.Delete
    Cancel = True
End If
'
End Sub
Anche questo codice va nel modulo vba del foglio di lavoro. L'effetto sara' che facendo doppioclick sulla colonna A della riga che vuoi rimuovere la riga e il suo contenuto sara' eliminato.

Per le date di aggiornamento, visto che sarebbe poco attendibile andare in giro per il workbook a modificare le date, devi intervenire sulla colonna K di AnagraficaProdotti.
Metti le date di aggiornamento in colonna P; quindi per il MetilEtilChetone in P4. Poi in K4 inserisci la formula
Codice: Seleziona tutto
='ANAGRAFICA PRODOTTI'!$P$4

Replica la formula nelle celle sottostanti (non basta copiarla, perche' l'indirizzo di cella e' "assoluto")

In questo modo, sugli altri fogli viene copiata la formula, che punta alla colonna P. Quindi quando aggiorni una data in colonna P la stessa data comparira' sui fogli dove la sostanza e' stata inserita.

Per il link al documento la situazione e' piu' complicata.
Io direi che potresti sfruttare l'evento FollowHyperlink. Cioe':
-modifichi l'hyperlink su AnagraficaProdotti
-poi sui fogli devi aggiungere una Sub Worksheet_FollowHyperlink, che quindi si attiva nel momento in cui si pigia sull'hyperlink della sostanza (hyperlink che potrebbe non essere aggiornato) e che comanda di seguire invece la Destination (aggiornata) presente su foglio Anagrafica

Il codice di questa Sub pero' lo devi pero' elaborare da solo perche' le suddette "esigenze di stagione" non mi lasciano tempo. Comunque se ti areni sai dove trovarci....

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

Re: 1_Sovrapposizione immagini (di 3)

Postdi BG66 » 18/12/19 09:22

Grazie Anthony nei prossimi giorni ci lavoro e ti aggiorno.

... esigenze "di stagione" mi hanno tenuto lontano dal pc...

Se si tratta di imbottigliare del Canavese DOC... disponibile come manovalanza :lol:

A presto.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: 1_Sovrapposizione immagini (di 3)

Postdi Anthony47 » 20/12/19 01:38

Se si tratta di imbottigliare del Canavese DOC... disponibile come manovalanza
Si, proprio il Canavese DOC; ma mi serviva un assaggiatore, quindi ho dovuto arrangiarmi in altro modo :D
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: 1_Sovrapposizione immagini (di 3)

Postdi BG66 » 22/12/19 10:03

Ciao Anthony,
bastava chiedere... anche se è un pò datato.....
Immagine

Tornando a noi:
Indipendentemente dal hyperlink (su cui non ho ancora ragionato) ho fatto un passo indietro e ho provato a sfruttare il foglio "Elenco" come matrice.
In pratica se nella colonna O (foglio"Elenco") digito SULB o GAMB quella riga viene copiate nel foglio corrispondente, se digito ALL in entrambi.
Codice: Seleziona tutto
Sub ricopia()
    Dim xRg As Range, xCell As Range, MR As Range, cel As Range
    Dim I As Long, J As Long, K As Long, L As Long

I = Worksheets("Elenco").UsedRange.Rows.Count
J = Worksheets("SULB").UsedRange.Rows.Count
L = Worksheets("GAMB").UsedRange.Rows.Count
        If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("SULB").UsedRange) = 0 Then J = 0
        End If
    Set xRg = Worksheets("Elenco").Range("O1:O" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.CutCopyMode = True
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "SULB" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("SULB").Range("A" & J + 1)
            J = J + 1
        ElseIf CStr(xRg(K).Value) = "GAMB" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("GAMB").Range("A" & L + 1)
            J = L + 1
            ElseIf CStr(xRg(K).Value) = "ALL" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("SULB").Range("A" & J + 1)
            xRg(K).EntireRow.Copy Destination:=Worksheets("GAMB").Range("A" & L + 1)
        End If
    Next
    Set MR = Worksheets("Elenco").Range("O2:O100")
    For Each cel In MR
        If cel.Value <> "" Then
        cel.ClearContents
    End If
    Next
   
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
 
End Sub

Funziona discretamente ma gli errori/ incapacità del sottoscritto sono:
a) vorrei che se la riga fosse già presente nei singoli fogli questa fosse sovrascritta e non duplicata
b) vorrei creare l'opzione Z che digitata in colonna O di Elenco cancellasse contemporaneamente la riga (se presente) negli altri due fogli
ma soprattutto:
c) Quando chiudo il file per due volte compare: "L'immagine è troppo grande è verrà troncata" -> navigando sono arrivato a questo consiglio ma non ha funzionato:
ho aggiunto al codice le due istruzioni seguenti:

Application.CommandBars("Office Clipboard").Visible = True
Application.CommandBars("Office Clipboard").Visible = False


il link: https://www.dropbox.com/s/bjyjw4q0y9yy07w/byBG66_lista%20prodotti%20chimici_FORUM_Ant_v03%2B.xlsm?dl=0

Grazie dell'aiuto, in assenza temporanea di Anthony, anche proveniente da "astemio"!! ;)

Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: 1_Sovrapposizione immagini (di 3)

Postdi Anthony47 » 23/12/19 11:21

Ho modificato la Sub ricopia come segue:
Codice: Seleziona tutto
Sub ricopiaA()
Dim I As Long, K As Long, myMatch, xRg As Range, J As Long, L As Long
Dim myNext As Long, M As Long, tSh As String, Niente, MR As Range, Cel As Range

I = Worksheets("Elenco").UsedRange.Rows.Count + 10

Set xRg = Worksheets("Elenco").Range("O1:O" & I)
For K = 1 To xRg.Count
    For M = 1 To 2
        If M = 1 Then tSh = "SULB" Else tSh = "GAMB"
        If UCase(xRg.Cells(K, 1).Value) = tSh Or UCase(xRg.Cells(K, 1).Value) = "ALL" _
          Or UCase(xRg.Cells(K, 1).Value) = "Z" Then
            myMatch = Application.Match(Sheets("Elenco").Cells(K, "B").Value, Sheets(tSh).Range("B1").Resize(10000, 1), False)
            If IsError(myMatch) Then
                myNext = Sheets(tSh).Range("B1").Offset(10000, 0).End(xlUp).Row + 1
            Else
                myNext = myMatch
            End If
            Niente = RowNoImg(myNext, tSh)
            Sheets(tSh).Cells(myNext, 1).Resize(1, 100).ClearContents
            If UCase(xRg.Cells(K, 1).Value) <> "Z" Then
                Sheets("Elenco").Cells(K, 1).Resize(1, 100).Copy Sheets(tSh).Cells(myNext, 1)
                Application.CutCopyMode = False
            Else
                Sheets(tSh).Cells(myNext, 1).EntireRow.Delete xlUp
            End If
           
        End If
    Next M
Next K
Set MR = Worksheets("Elenco").Range("O2:O1000")
For Each Cel In MR
    If Cel.Value <> "" Then
        Cel.ClearContents
    End If
Next Cel
Application.CutCopyMode = False
End Sub

Function RowNoImg(ByVal RowN As Long, ByVal tSh As String)
    Dim Sh As Shape
    For Each Sh In Sheets(tSh).Shapes
        Debug.Print Sh.TopLeftCell.Address, Sh.Type
        If Sh.Type = msoPicture Then
            If Sh.TopLeftCell.Column > 2 And Sh.TopLeftCell.Column < 10 And Sh.TopLeftCell.Row = RowN Then
                Sh.Delete
            End If
        End If
    Next Sh
End Function

Dovrebbe gestire l'aggiunta sui fogli (NomeFoglio oppure All) e anche la cancellazione (opzione Z)
Quanto all'errore in chiusura, non l'ho riprodotto ma magari la diversa gestione del CutCopyMode potrebbe aiutare

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

Re: 1_Sovrapposizione immagini (di 3)

Postdi BG66 » 23/12/19 13:46

Ciao Anthony,
E' perfetta.

Quando hai tempo, mi aiuti a capire dandomi una piccola spiegazione sulla parte dello script "Function RowNoImg(ByVal RowN As Long, ByVal tSh As String)..."

Ora mi resta "solo"provare a lavorare sulla parte hyperlink.

Grazie
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: 1_Sovrapposizione immagini (di 3)

Postdi Anthony47 » 23/12/19 23:16

Quella funzione serve per eliminare dai fogli "SULB" e "GAMB" eventuali Immagini giacenti nelle colonne C-D-E-F prima di copiare una riga da foglio Elenco; sfrutta la proprieta' "TopLeftCell" delle immagini per determinare la loro posizione.

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

Re: 1_Sovrapposizione immagini (di 3)

Postdi BG66 » 24/12/19 14:32

[RISOLTO]
Ciao Anthony,
per mantenere pulito il thread metto risolto in questo.
E per eventuale aiuto su hyperlink ne apro uno nuovo.

Grazie e Buon Natale.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44

Re: 1_Sovrapposizione immagini (di 3)

Postdi BG66 » 24/12/19 15:28

[RISOLTO] Definitivamente

Anche il pezzo Hyperlink nel tuo script funziona !!! :lol:

...Ora tiro giù la serranda... BUON 2020 a tutti...

Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 320
Iscritto il: 20/08/16 07:44


Torna a Applicazioni Office Windows


Topic correlati a "1_Sovrapposizione immagini (di 3)":


Chi c’è in linea

Visitano il forum: Nessuno e 24 ospiti