Condividi:        

Nr. progressivo e sostituisci immagini

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

Nr. progressivo e sostituisci immagini

Postdi BG66 » 15/10/23 07:41

Ciao a tutti.
Due aiuti per lo stesso file.
1°= inserire il numero progressivo nella colonna A quando da foglio"Scheda infortunio" uso la macro "creastorico2c"
-> Non ho tentativi da proporre perchè non ho capito come fare!!

2°= nella stessa cartella ho delle immagini che vorrei importare nella riga 17 ( max 4) rimpiazzano l'immagine di default "INSERISCI QUI L'IMMAGINE".
-> Le prove fatte sono state partire da questa macro:
Codice: Seleziona tutto
Sub InserisciImmagini()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub


....che teoricamente fa il suo dovere ma importa le foto dove gli pare!!
https://www.dropbox.com/scl/fi/nzbah3ka2skyl23si96vc/Prove-sviluppoForum.rar?rlkey=9qbajk6pgyio4wyye9h2kc6r7&dl=0

PS quando chiudo il file vorrei comunque che si ripristinassero le 4 immagini di default.

Grazie per il solito aiuto.
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 323
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: Nr. progressivo e sostituisci immagini

Postdi BG66 » 15/10/23 08:11

...dimenticavo
La scelta della foto da caricare è dettata dal riferimento inserito nella cella P16.
In pratica se il testo è In01-2023 dovrebbe caricare 3 immagine. Se è In02-2023 solamente una.

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

Re: Nr. progressivo e sostituisci immagini

Postdi Marius44 » 15/10/23 17:17

Ciao Gene

punto 1)
Nella tua macro CreaStorico2c ad un certo punto c'è questa riga di codice
'trovo l'ultima riga occupata + 1 per predere la cella vuota
Ur = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
aggiungi altra variabile per assumere il numero nella riga precedente, incrementalo di 1 e scrivi questo nuovo numero nella cella "vuota" trovata in precedenza.

Punto 2)
Nella tua macro InserisciImmagini ci sono queste due righe:
....
xColIndex = Application.ActiveCell.Column
,,,,
xRowIndex = Application.ActiveCell.Row
,,,,
Dove vuoi che il codice inserisca l'immagine? Ovviamente in Range(xRowIndex,xColIndex) che altro non è se non la cella attiva!
Prova a dare come riferimenti non quelli relativi alla cella attiva bensì dove vuoi che l'immagine venga inserita;
per es. in Range("A17").Top e Range("A17").Left

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

Re: Nr. progressivo e sostituisci immagini

Postdi BG66 » 15/10/23 20:46

Ciao Mario,
Sul punto 1 ero arrivato a
Codice: Seleziona tutto
Cells(iRow, 1) = (iRow - 5) + 1

ma poi mi si è fermato il cervello per sovraccarico e non sono riuscito più ad andare avanti.
E in più mi hanno anche avvisato che qualcuno aveva deciso di entrare senza invito nella casa di montagna e ho dovuto farmi tre ore di macchina per verificare l'accaduto :evil:

Sul punto 2 in realtà come mia abitudine ho reso la cosa... più complessa del possibile!!
Infatti:
1) le foto possono essere di numero differente ( ovviamente max 4) e "richiamate" dal testo presente in P16.
2) Alla chiusura del file vorrei ri-sostituirle con le 4 immagini di default
Risultato sono fermo al via!!

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

Re: Nr. progressivo e sostituisci immagini

Postdi BG66 » 15/10/23 21:06

Forse tu intendevi qualcosa di simile?

Codice: Seleziona tutto
Sub NumeroProgressivo()
    Dim uR As Long
    Dim nProgr As Long
    uR = Cells(Rows.Count, 1).End(xlUp).Row
    If IsNumeric(Cells(uR, 1)) Then
        nProgr = Cells(uR, 1) + 1
    Else
        nProgressivo = 1
    End If
    Cells(uR + 1, 1) = nProgr
End Sub

ATTENZIONE: preso da un thread 2020 del mitico GES.
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 323
Iscritto il: 20/08/16 07:44

Re: Nr. progressivo e sostituisci immagini

Postdi Anthony47 » 15/10/23 22:03

Rispondo in modo piu' articolato rispetto a Mario che nel tardo pomeriggio e' gia' sveglio, mentre io devo aspettare la sera per dare segni di vita...

Intanto(1): ma se ti sbatti per fare dei Set, perche' non li fai che hanno un senso?
Cioe' invece di, ad esempio, Set sh1 = Worksheets("Scheda infortunio") per riferirti al "secondo" foglio, perche' non fai Set Scheda= Worksheets("Scheda infortunio"); così forse a colpo d'occhio saprai che ti riferisci a "Scheda infortunio" invece di dover andare tutte le volte a controllare se Sh1 si riferiva al foglio 1 o al forglio2...
Intanto(2): in una Tabella non puoi usare il classico Cells(Rows.Count, 1).End(xlUp).Row per determinare l'ultimo rigo usato, perche' quel criterio ti restituira' l'ultima riga della tabella, vuota o compilata che sia.
E' poiché e' abbastanza incasinato accodare dati all'interno di una tabella il mio consiglio e' che su foglio DB_Eventi ti scordi la tabella e lavori accodando i dati dopo le intestazioni di riga 5 (la Tabella va rimossa; se hai gia' inserito dei dati allora usa il comando Converti-in-Intervallo, presente sotto il tab Struttura-Tabella).

Cio' premesso, dato per scontato che procedi come suggerito in "Intanto(2)":
Per incrementare colonna A del DB, dopo aver calcolato Ur, trasferisci i dati da Scheda a DB e poi continui con
Codice: Seleziona tutto
 
'sh2.Cells(Ur, 16) = sh1.Cells(19, 7) 'GG. Prognosi   'Tuo codice per trasferimento
If IsNumeric(sh2.Cells(Ur - 1, "A").Value) Then       'AGGIUNTA per +1 in col A
    sh2.Cells(Ur, "A").Value = sh2.Cells(Ur - 1, "A").Value + 1
Else
    sh2.Cells(Ur, "A").Value = 1
End If

'sh2.Columns("M").EntireRow.AutoFit         'Nooo
sh2.Cells(Ur, "M").WrapText = True         'MEGLIO
MsgBox "Aggiornamento completato", vbInformation   'Continua verso End Sub

Come vedi mi sono permesso di eliminare AutoFit e inserire WrapText su colonna M


Quanto all'inserimento della Immagini, il mio suggerimento è:
1) Rinomina le 4 immagini "segnaposto" come Immagine_a1, Immagine_a2, ... _a4
2) Quando esegui la Sub InserisciImmagini, in testa cancella le immagini eventualmente inserite precedentemente (vedi "3") e rendi visibili le immagini "segnaposto" (vedi "3")
3) Quando inserisci le immagini selezionate, assegna a queste immagini il nome arbitrario Accid_01, Accid_02, ... _04 (serve per poterle poi cancellare facilmente) e contemporaneamente nascondi le immagini segnaposto (senza cancellarle)
4) Ma se hai previsto che le immagini vengano selezionate tramite GetOpenFilename, che senso ha usare P16 (e immagino Q16, R16 ed S16 per le immagini successive)? Quale e' il problema con GetOpenFilename?

Cio' detto, sapendo che le immagini previste sono max 4, e rimanendo con l'uso di GetOpenFilename, il codice complessivo puo' essere:
Codice: Seleziona tutto
Sub InserisciImmagini1()
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range, lLoop As Long
Dim sShape As Shape
'
Sheets("Scheda infortunio").Select
On Error Resume Next
For lLoop = 1 To 4
    ActiveSheet.Shapes("Accid_" & Format(lLoop, "00")).Delete
    ActiveSheet.Shapes("Immagine_a" & lLoop).Visible = True
    DoEvents
Next lLoop
DoEvents
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
If IsArray(PicList) Then
    For lLoop = LBound(PicList) To 4
        ActiveSheet.Shapes("Immagine_a" & lLoop).Visible = False
        If lLoop <= UBound(PicList) Then
            Set Rng = Range("B17").Cells(1, lLoop)
            Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
            sShape.Name = "Accid_" & Format(lLoop, "00")
        End If
    Next
End If
End Sub

Se vuoi, puoi inserire nella Sub Workbook_Open del file le stesse istruzioni che, in testa alla suddetta Sub InserisciImmagini1, cancellano le immagini inserite e rendono visibili i segnaposto.

Spero sia tutto comprensibile

PS: Su Scheda infortunio ho supposto che le immagini debbano andare in B-C-D ed E; ovviamente colonna E non dovrebbe essere stretta come la si trova sul tuo file dimostrativo (meno di 10 px)
Avatar utente
Anthony47
Moderatore
 
Post: 19299
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Nr. progressivo e sostituisci immagini

Postdi BG66 » 16/10/23 05:55

Ciao Anthony
Punto 1: partendo dai tuo consigli e applicando quanto scritto -> RISOLTO ma mi aiuti a capire meglio la funzione WRAP TEXT?

Punto 2 ( ovviamente più complesso perchè sono andato a tentoni quando ho provato ad arrivare a qualcosa da solo):
In merito a P16 ... l'idea unendo le celle e in presenza delle 4 immagini di default era quella di "dire" alla macro:
1) vai in P16 -- leggi il prefisso delle foto che devi caricare -- cercale nella cartella -- sostituiscile a quelle di default -- e fermati lì!!
Quindi non avevo bisogno di avere le celle B-C-D e soprattutto E delle stesse dimensioni.

Lo sai che sono fissato per la parte "grafica" dei moduli che creo e modificare la cella E lo renderebbe "meno bello".
Al momento senza automatismi e ignorando le dimensioni delle celle presenti nella riga 17 si presenta cosi:
Immagine
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 323
Iscritto il: 20/08/16 07:44

Re: Nr. progressivo e sostituisci immagini

Postdi Anthony47 » 16/10/23 11:39

Pero' non ho capito se stai dicendo che ora e' tutto a posto e come piace a te, oppure...

Nell'ipotesi che tu voglia usare le "immagini segnaposto" proprio per determinare la posizione delle nuove immagini, e nell'ipotesi che i segnaposto non occupati da immagini vanno nascosti, allora potresti sostituire il loop interno con:
Codice: Seleziona tutto
If IsArray(PicList) Then
    For lLoop = LBound(PicList) To 4
        ActiveSheet.Shapes("Immagine_a" & lLoop).Visible = False
        If lLoop <= UBound(PicList) Then
            With ActiveSheet.Shapes("Immagine_a" & lLoop)
'                Set Rng = Range("B17").Cells(1, lLoop)
                Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, .Left, .Top, .Width, .Height)
                sShape.Name = "Accid_" & Format(lLoop, "00")
            End With
        End If
    Next
End If

Questo presuppone che tu abbia preventivamente rinominato le immagini segnaposto come "Immagine_Ax"
Avatar utente
Anthony47
Moderatore
 
Post: 19299
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Nr. progressivo e sostituisci immagini

Postdi BG66 » 16/10/23 11:50

Ciao Anthony,
Anthony47 ha scritto:Pero' non ho capito se stai dicendo che ora e' tutto a posto e come piace a te, oppure...

Ero orientato sull'oppure.... :oops: ma la tua proposta mette tutto nella "giusta direzione".

Stasera spero di provarla e di restituirti un feedback.

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

Re: Nr. progressivo e sostituisci immagini

Postdi BG66 » 19/10/23 21:09

Ciao @Anthony,
ovviamente è perfetta.
Scusa il ritardo nella risposta ma è una settimana tostissima....e non è ancora finita!!!

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


Torna a Applicazioni Office Windows


Topic correlati a "Nr. progressivo e sostituisci immagini":


Chi c’è in linea

Visitano il forum: Nessuno e 31 ospiti