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)
ma la tua proposta mette tutto nella "giusta direzione".