Tracciare nominativo di chi modifica il file

[systemcrack]

Ah si.. è quello il problema.. non ho pensato a renderli visibili prima di zipparli. Grande Dylan!!!

[Anthony47]

La casella G1 del file Tip.MERCE a che serve?

Quella cella salvera' il nickname scelto, che sara' poi utilizzato all'interno della Sub Worksheet_Change:

Codice: Seleziona tutto

For Each myC In Worked
        'Inserisci log in colonna H:
        Cells(myC.Row, "H").Value = "Utente: " & Sheets("TIP.MERCE").Range("G1").Value & " - Time: " & Format(Now, "dd-mmm-yy hh:mm")
    Next myC


La seconda domanda è.. invece che creare un altro file, posso fare tutto sullo stesso: LocMerce - piazzale?

Non capisco la domanda... Con quanto ti ho proposto non c'e' nessun secondo file da creare

[systemcrack]

La seconda domanda è.. invece che creare un altro file, posso fare tutto sullo stesso: LocMerce - piazzale?

Non capisco la domanda... Con quanto ti ho proposto non c'e' nessun secondo file da creare

...ad esempio:
1) Su foglio TIP.MERCE, in D1:Dxx crei un elenco di nickname che le persone useranno; in D1 inserire la dicitura "Scegli Utente", funzionera' da Intestazione dell'elenco.

Questo.. TIP.MERCE

[Dylan666]

Parla di un foglio, non di un file.

[systemcrack]

Ho visto ora scusate.. essendo nascosto quel foglio non lo avevo proprio più considerato.

[Anthony47]

Pensavo che conoscessi a memoria la struttura del tuo workbook...
Su quel foglio c'e' gia' un altro "Elenco", ho pensato di usarlo per il nuovo elenco dei nicknames e per memorizzarci la scelta fatta all'apertura.
Ciao

[systemcrack]

Pensavo che conoscessi a memoria la struttura del tuo workbook...
Su quel foglio c'e' gia' un altro "Elenco", ho pensato di usarlo per il nuovo elenco dei nicknames e per memorizzarci la scelta fatta all'apertura.
Ciao

Hai ragionissimo Anthony il fatto è che questi files li ho creati mesi fa, tra un buco e l'altro in ufficio e ci lavoro su solo ogni tanto o come in questo caso non li uso più (perchè utilizzati da altri), fino a quando non c'è bisogno che ci rimetta mano... Ovviamente con tante cose a cui pensare, soprattutto di questi tempi, mi dimentico dei pezzi.

Detto questo ho fatto l'esperimento sul file. Sembra andare abbastanza bene ora, all'inizio s'impallava.. cioè che il il cursore del mouse gira un tot prima di una reazione e anche se seleziono una delle voci non parte. Che sia la temporizzazione?

Mi chiedo, ma invece di mettere una cosa a tempo non si potrebbe far permanere la finestrella con i nomi da selezionare fino a quando la scelta non è stata eseguita?
Il secondo quesito è rivolto all'input utente.. da cosa è dovuto dalla selezione del nominativo o altro? Mi chiedo anche qui se non abbinare tutto ad un bottone da cliccare successivamente la scelta del nominativo.

Di seguito riporto il codice dei vari fogli:

Foglio1 - Loc.Merce

Codice: Seleziona tutto

Private Sub ListBox1_Click()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRan As String
Dim myC As Range, Worked As Range
'
myRan = "F3:G1000"
Set Worked = Application.Intersect(Target, Range(myRan))
If Not Worked Is Nothing Then
    Application.EnableEvents = False
    For Each myC In Worked
        'Inserisci log in colonna H:
        Cells(myC.Row, "H").Value = "Utente: " & Sheets("TIP.MERCE").Range("G1").Value & " - Time: " & Format(Now, "dd-mmm-yy hh:mm")
    Next myC
    Application.EnableEvents = True
End If
'Continua il codice originale:
myRan = "F3:F1000"       '<<< L'area per i cui cambiamenti viene subito fatto un File Save
If Application.Intersect(Target, Range(myRan)) Is Nothing Then Exit Sub
Debug.Print Now, Target.Address
ThisWorkbook.Save
End Sub


Questa cartella di lavoro

Codice: Seleziona tutto

Private Sub Workbook_Open()
Dim Ckwb As Workbook, myTim As Single
'
Sheets("TIP.MERCE").Range("G1").ClearContents
Sheets("LOC.MERCE").Select
With ActiveSheet.Shapes.Range(Array("ListBox1"))
    .Visible = True
    .Top = ActiveWindow.VisibleRange.Cells(2, 3).Top * 1.1
    .Left = ActiveWindow.VisibleRange.Cells(2, 3).Left * 1.1
End With
myTim = Timer
Do
'attesa scelta:
    DoEvents: DoEvents
    Application.Wait (Now + TimeValue("0:00:01"))
    If Sheets("TIP.MERCE").Range("G1") <> "" Then Exit Do
    If (Timer - myTim) > 60 Or Timer < myTim Then
    'uscita per TimeOut=60 sec
        MsgBox ("Nessuna scelta fatta")
        Sheets("TIP.MERCE").Range("G1").Value = "NonSelezionato"
        Exit Do
    End If
    DoEvents: DoEvents
Loop
'Nascondi ListBox:
ActiveSheet.Shapes.Range(Array("ListBox1")).Visible = False
'Continua il codice originale:
FFName = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
On Error Resume Next
    Set Ckwb = Workbooks(mySplit(UBound(mySplit)))
On Error GoTo 0
If Ckwb Is Nothing Then
    Workbooks.Open Filename:=FFName, ReadOnly:=True
End If
Call CloseOpen
ThisWorkbook.Activate          '<<<
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

FFName = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
On Error Resume Next
    Workbooks(mySplit(UBound(mySplit))).Close False
    If myNext > Now Then Application.OnTime myNext, "CloseOpen", , False
On Error Resume Next
End Sub


Modulo

Codice: Seleziona tutto

Sub CloseOpen()
'Stop
Dim Ckwb As Workbook, mySplit, FFName As String
FFName = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
On Error Resume Next
    Set Ckwb = Workbooks(mySplit(UBound(mySplit)))
On Error GoTo 0
If Ckwb Is Nothing Then Exit Sub
Workbooks(mySplit(UBound(mySplit))).Close False
DoEvents
Workbooks.Open Filename:=FFName, ReadOnly:=True
myNext = Now + TimeSerial(0, 30, 0)
Application.OnTime myNext, "CloseOpen"
End Sub

Screen impostazioni casella di riepilogo

Ho rimosso la Macro2 per il momento perchè nell'apri e chiudi dei test rallentava.

[Anthony47]

Sembra andare abbastanza bene ora, all'inizio s'impallava.. cioè che il il cursore del mouse gira un tot prima di una reazione e anche se seleziono una delle voci non parte. Che sia la temporizzazione?

Per migliorare l'esperienza utente:
1) in testa a un modulo standard (prima di qualsiasi Sub o Function) metti questa dichiarazione:

Codice: Seleziona tutto

#If VBA7 Then       '!!!  IN TESTA  !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End I


2) Poi modifica il ciclo di "attesa scelta":

Codice: Seleziona tutto

Do
'attesa scelta:
    DoEvents: DoEvents
'    Application.Wait (Now + TimeValue("0:00:01"))
    Sleep 500
    If Sheets("TIP.MERCE").Range("G1") <> "" Then Exit Do
    If (Timer - myTim) > 60 Or Timer < myTim Then
    'uscita per TimeOut=60 sec
        MsgBox ("Nessuna scelta fatta")
        Sheets("TIP.MERCE").Range("G1").Value = "ALTRO"
        Exit Do
        Sleep 1000
    End If
    DoEvents: DoEvents
Loop


Codice: Seleziona tutto

Mi chiedo, ma invece di mettere una cosa a tempo non si potrebbe far permanere la finestrella con i nomi da selezionare fino a quando la scelta non è stata eseguita?

In effetti mi chiedevo cosa fare se l'utente non fa una scelta... Al momento dopo 60 sec compare un messaggio (bloccante fino all'OK) che avverte l'utente (colui che per 60 sec non ha fatto niente) che "non ha fatto niente" e imposta un utente di default... Non e' il massimo della logica
Puoi eliminare il msgbox, così il file si apre e dopo 60 sec si predispone a lavorare con l'utente "Altro"
Oppure puoi mantenere il messaggio (quasi) a oltranza sostituendo quel If (Timer - myTim) > 60 Or Timer < myTim Then con If (Timer - myTim) > 6000 Or Timer < myTim Then
(questa seconda modifica e' subordinata alla modifica precedente, altrimenti rischieresti di trovarti un elevato utilizzo della cpu durante l'attesa)

Il secondo quesito è rivolto all'input utente.. da cosa è dovuto dalla selezione del nominativo o altro? Mi chiedo anche qui se non abbinare tutto ad un bottone da cliccare successivamente la scelta del nominativo

Qui potrei non aver capito...
Ora il nickname dell'operatore viene scelto all'apertura del file, seguendo il tuo ragionamento:

la mia idea che era di lavorare solo sul file LocMerce - piazzale.xlsm in cui vorrei che all'apertura del file si apra una finestrella (o con il menù oppure faccio inserire il diminutivo direttamente dai ragazzi).

Ma nulla impedisce di aggiungere un pulsante per fare la scelta da pulsante e non (solo) all'apertura del file.
In questo caso va trasferito su una macro il codice ora nella Workbook_Open che fa fare la scelta, e chiamare questo codice dalla Workbook_Open oltre che dal pulsante. Cioe'
1) In un modulo standard:

Codice: Seleziona tutto

Sub SceltaNick()
'
Sheets("TIP.MERCE").Range("G1").ClearContents
Sheets("LOC.MERCE").Select
'
With ActiveSheet.Shapes.Range(Array("ListBox1"))
    .Visible = True
    .Top = ActiveWindow.VisibleRange.Cells(2, 3).Top * 1.1
    .Left = ActiveWindow.VisibleRange.Cells(2, 3).Left * 1.1
End With
myTim = Timer
Do
'attesa scelta:
    DoEvents: DoEvents
    Sleep 500
    If Sheets("TIP.MERCE").Range("G1") <> "" Then Exit Do
    If (Timer - myTim) > 60 Or Timer < myTim Then
    'uscita per TimeOut=60 sec
        MsgBox ("Nessuna scelta fatta")
        Sheets("TIP.MERCE").Range("G1").Value = "ALTRO"
        Exit Do
        Sleep 1000
    End If
    DoEvents: DoEvents
Loop
'Nascondi ListBox:
ActiveSheet.Shapes.Range(Array("ListBox1")).Visible = False
End Sub


(valgono per questa Sub le considerazioni fatte prima sulla persistenza della richiesta)

2) La Workbook_Open:

Codice: Seleziona tutto

Private Sub Workbook_Open()
Dim Ckwb As Workbook, myTim As Single
'
Call SceltaNick
'Continua il codice originale:
FFName = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
'etc etc


Ciao

[systemcrack]

Ciao Anthony.

Sembra andare abbastanza bene ora, all'inizio s'impallava.. cioè che il il cursore del mouse gira un tot prima di una reazione e anche se seleziono una delle voci non parte. Che sia la temporizzazione?

Per migliorare l'esperienza utente:
1) in testa a un modulo standard (prima di qualsiasi Sub o Function) metti questa dichiarazione:

Codice: Seleziona tutto

#If VBA7 Then       '!!!  IN TESTA  !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End I


Questa ha qualche cosa che non va.. forse doveva essere così?

Codice: Seleziona tutto

#If VBA7 Then       '!!!  IN TESTA  !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#End If


Anche se ricevo nonostante sistemato un errore comunque, mentre se non inserisco questa porzione di codice ricevo un errore 500

2) La Workbook_Open:

Codice: Seleziona tutto

Private Sub Workbook_Open()
Dim Ckwb As Workbook, myTim As Single
'
Call SceltaNick
'Continua il codice originale:
FFName = "Q:\SCANNERTRASPORTI\DOC UFF TRASPORTI\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
'etc etc


Ciao

Questo step mi ha messo in difficoltà e non sono sicuro di avere composto il codice bene, il che sarà molto probabile dal momento in cui mi compare la lista di nomi, il bottone, ma se clicco, non posso selezionare il nominativo
Allego di seguito il file incriminato qui.

[Gianca532011]

Scusatemi, il tread mi ha incuriosito, quindi mi sono chiesto se non sia possibile collegare a excel un lettore di codice a barre che identifichi univocamente la persona, un pò come i badge di accesso/timbratura di presenza . A quanto pare sembra che questa applicazione sia cosa già fatta e applicabile ad excel.
Cosi, solo per dare un aiuto.

E anche vero, come diceva Marius all'inizio, che nulla vieta al personale di scambiarsi la tessera con i codici , ma qui stiamo parlando di persone adulte e non di asilo...

[Dylan666]

Scusatemi, il tread mi ha incuriosito, quindi mi sono chiesto se non sia possibile collegare a excel un lettore di codice a barre che identifichi univocamente la persona

I lettori di codici a barre sono riconosciuti dai PC come "tastiere".
Il lettore legge il codice e poi semplicemente lo "scrive" in qualunque parte in cui si possa scrivere, sia un Notepad, una pagina di Word, una finestra di login o una cella Excel.

Il suo scopo è solo diminuire gli errori di digitazione. Se lo stesso numero lo premi sui tasti è esattamente la stessa cosa.
Esattamente come succede alla cassa quando un codice non è leggibile dalla "pistola" e viene immesso a mano.

PS:
in realtà volendo ci sono ANCHE lettori più avanzati, ma quelli hanno driver e librerie esterne, vanno pilotati da programmi appositi e bla bla bla... non vado avanti perché non credo ci interessi. Si sappia solo che ho semplificato.

[Gianca532011]

"Il lettore legge il codice e poi semplicemente lo "scrive" in qualunque parte in cui si possa scrivere, sia un Notepad, una pagina di Word, una finestra di login o una cella Excel."

Appunto! Se hai il tuo tesserino univoco e personale che ti identifica, scriverai il codice a barre direttamente sul foglio excel che vai a modificare, non necessariamente in forma visibile a tutti. A me sembra semplice . Comunque fate vobis.

[Dylan666]

Il codice personale che ti identifica è semplicemente un numero.
Se lo scopro posso poi semplicemente scriverlo a mano con la tastiera.
Per leggerlo basta un qualunque cellulare, posso anche solo fotografare il codice e leggerlo con calma dopo.
Oppure, se volontariamente voglio diffonderlo, basta una fotocopia.
Non capisco dove sia la sicurezza aggiuntiva

[systemcrack]

Molto interessante ragazzi e vi ringrazio davvero per gli spunti, ma al momento mi accontenterei di far funzionare la variante, con il bottone, di Anthony. Come già detto è solo un promemoria anche per i ragazzi stessi del reparto, dei cambiamenti del file, non un controllo vero e proprio. Anche perché io non sono un superiore e non impongo nulla, ma faccio esclusivamente seguito alle richieste/lamentele, (lavorative dovute alle carenze aziendali), dei colleghi. Alla fine in realtà su 6-7 persone che fanno parte della squadra, solo 2-3 utilizzeranno il file in modo costante. Spero di essere riuscito a spiegare meglio la situazione.

[Anthony47]

Allora...
1) Si, mancava una piccola "f" in fondo a "#End If"; hai fatto bene a correggere

2) Dici che ti dà errore sulla Declare Sub Sleep Lib "kernel32" etc etc... Tu che versione Excel usi, perche' da XL2010 in poi quella riga non dovrebbe nemmeno essere presa in considerazione, essendo una Else di una compilazione condizionale in cui solo la prima condizione viene esaminata...
Comunque prova a sostituire tutto il blocco con:
a) la sola Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) se usi XL2010 o superiore
b) oppure la sola Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) se usi una versione precedente
c) oppure con quella delle due che ti funziona

3) dici:

Questo step mi ha messo in difficoltà e non sono sicuro di avere composto il codice bene, il che sarà molto probabile dal momento in cui mi compare la lista di nomi, il bottone, ma se clicco, non posso selezionare il nominativo

Se la definizione della Sleep ti dà errore allora la Sub SceltaNick non dovrebbe eseguirsi, segnalando però qualcosa come "funzione non definita" sulla riga Sleep. Riga che serve a farti vedere per 1 secondo la scelta che hai fatto, prima che il listbox si nasconda e la macro vada avanti e si completi.
Quindi se metti a posto la 2 (sopra) dovrebbe funzionare anche la Sub SceltaNick: esce il listbox, fai la scelta, dopo circa 1 sec il listbox scompare e il nickname dell'utente scelto e' pronto per essere scritto in colonna H

Spero ne veniamo fuori...

[systemcrack]

Buon giorno a tutti, mi scuso per l'assenza, ma sono mezzo influenzato e questo week end ero sul moribondo!

Guardando con un pò di calma stamane, mi sono accorto forse di un'altra mancanza sempre qui:

Codice: Seleziona tutto

#If VBA7 Then       '!!!  IN TESTA  !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#End If

Nella prima parte viene riportato:

Codice: Seleziona tutto

Declare PtrSafe Sub Sleep

Mentre nella seconda parte:

Codice: Seleziona tutto

Declare Sub Sleep Lib

Che anche qui manchi qualche cosa e che quindi debba essere così:

Codice: Seleziona tutto

#If VBA7 Then       '!!!  IN TESTA  !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#End If

Faccio qualche prova e vi faccio sapere.

[Anthony47]

No, e' giusta come te l'ho scritta
Anche perche' non avrebbe senso scrivere

Codice: Seleziona tutto

Se Caso1 Allora
    Fai una cosa
Altrimenti
    Fai la stessa cosa
End Se

Piuttosto, se hai problemi con questa parte (e non ho capito quali sono) segui questo suggerimento:

Comunque prova a sostituire tutto il blocco con:
a) la sola Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) se usi XL2010 o superiore
b) oppure la sola Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) se usi una versione precedente
c) oppure con quella delle due che ti funziona

[systemcrack]

Dopo qualche prova con la correzione non da più errore.. Ottimo!!!
Ora compare la tabellina con i nomi ed il bottone, ma non mi fa selezionare nessun nome e se clicco ovviamente non accade nulla.
Sicuramente sto sbagliando qualche cosa io.. quindi riporto i codici dei fogli che lo compongono e un paio di screen.

Foglio1(LOC.MERCE)

Codice: Seleziona tutto

Private Sub ListBox1_Click()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRan As String
Dim myC As Range, Worked As Range
'
myRan = "F3:G1000"
Set Worked = Application.Intersect(Target, Range(myRan))
If Not Worked Is Nothing Then
    Application.EnableEvents = False
    For Each myC In Worked
        'Inserisci log in colonna H:
        Cells(myC.Row, "H").Value = "Utente: " & Sheets("TIP.MERCE").Range("G1").Value & " - Time: " & Format(Now, "dd-mmm-yy hh:mm")
    Next myC
    Application.EnableEvents = True
End If
'Continua il codice originale:
myRan = "F3:F1000"       '<<< L'area per i cui cambiamenti viene subito fatto un File Save
If Application.Intersect(Target, Range(myRan)) Is Nothing Then Exit Sub
Debug.Print Now, Target.Address
ThisWorkbook.Save
End Sub


Questa cartella di lavoro:

Codice: Seleziona tutto

Private Sub Workbook_Open()
Dim Ckwb As Workbook, myTim As Single
'
Call SceltaNick

'Continua il codice originale:
FFName = "O:\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
On Error Resume Next
    Set Ckwb = Workbooks(mySplit(UBound(mySplit)))
On Error GoTo 0
If Ckwb Is Nothing Then
    Workbooks.Open Filename:=FFName, ReadOnly:=True
End If
Call CloseOpen
ThisWorkbook.Activate          '<<<
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
FFName = "O:\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
On Error Resume Next
    Workbooks(mySplit(UBound(mySplit))).Close False
    If myNext > Now Then Application.OnTime myNext, "CloseOpen", , False
On Error Resume Next
End Sub


Modulo1

Codice: Seleziona tutto

#If VBA7 Then       '!!!  IN TESTA  !!!!
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#End If

Sub Macro2()

nomecopia = "O:\Salvataggi\Salvataggi Lolcalizza merce" & Hour(Now()) & "." & Minute(Now()) & " " & "-" & " " & Day(Date) & "." & Month(Date) & "." & Year(Date) & " " & ThisWorkbook.Name

ThisWorkbook.SaveCopyAs nomecopia


End Sub


Sub CloseOpen()
'Stop
Dim Ckwb As Workbook, mySplit, FFName As String
FFName = "O:\PRATICHE SIDERURGICO.xlsx"                 '<<< Percorso e nome del file da aprire
mySplit = Split(FFName, "\", , vbTextCompare)
On Error Resume Next
    Set Ckwb = Workbooks(mySplit(UBound(mySplit)))
On Error GoTo 0
If Ckwb Is Nothing Then Exit Sub
Workbooks(mySplit(UBound(mySplit))).Close False
DoEvents
Workbooks.Open Filename:=FFName, ReadOnly:=True
myNext = Now + TimeSerial(0, 30, 0)
Application.OnTime myNext, "CloseOpen"
End Sub


Sub SceltaNick()
'
Sheets("TIP.MERCE").Range("G1").ClearContents
Sheets("LOC.MERCE").Select
'
With ActiveSheet.Shapes.Range(Array("ListBox1"))
    .Visible = True
    .Top = ActiveWindow.VisibleRange.Cells(2, 3).Top * 1.1
    .Left = ActiveWindow.VisibleRange.Cells(2, 3).Left * 1.1
End With
myTim = Timer
Do
'attesa scelta:
    DoEvents: DoEvents
    Sleep 500
    If Sheets("TIP.MERCE").Range("G1") <> "" Then Exit Do
    If (Timer - myTim) > 6000 Or Timer < myTim Then
    'uscita per TimeOut=60 sec
        MsgBox ("Nessuna scelta fatta")
        Sheets("TIP.MERCE").Range("G1").Value = "ALTRO"
        Exit Do
        Sleep 1000
    End If
    DoEvents: DoEvents
Loop
'Nascondi ListBox:
ActiveSheet.Shapes.Range(Array("ListBox1")).Visible = False
End Sub


Screen impostazioni tabella | Screen impostazioni bottone

******* / ******* / *********

Piuttosto, se hai problemi con questa parte (e non ho capito quali sono) segui questo suggerimento:

Comunque prova a sostituire tutto il blocco con:
a) la sola Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) se usi XL2010 o superiore
b) oppure la sola Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) se usi una versione precedente
c) oppure con quella delle due che ti funziona

Si Anthony, hai ragione tu.. così funziona. Però c'è sempre la selezione che parte senza il click del bottone, che tra l'altro mi compare staccato dalla tabellina.. Se clicco sul pulsante, mi ricompare la tabellina e mi ridà la posibilità di selezionare l'utente (non male anche questo comunque).

[systemcrack]

Dopo alcuni Test è perfetto così.. ho separato il pulsante e l'ho rinominato: cambia utente. Ora quando i ragazzi accedono selezionano il nominativo e accedono (senza cliccare nulla), se vi è necessità di cambiare utente cliccano sul pulsante e ricompare la tabellina con i nomi da riselezionare. Direi che è praticamente perfetta!

[Anthony47]

Da progetto doveva funzionare così:
-all'apertura del file compare il listbox che invita a scegliere dall'elenco
-dopo l'apertura del file e' possibile cliccare il pulsante "Cambia Utente" che ripete la fase di scelta via listbox
In ambedue i casi la scelta fatta rimane evidenziata per circa 1 sec prima della chiusura del listbox.

Se ora e' così, allora e' perfetto.
Se comunque funziona come volevi, allora e' perfettissimo