Moderatori: Anthony47, Flash30005
Quella cella salvera' il nickname scelto, che sara' poi utilizzato all'interno della Sub Worksheet_Change:La casella G1 del file Tip.MERCE a che serve?
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
Non capisco la domanda... Con quanto ti ho proposto non c'e' nessun secondo file da creareLa seconda domanda è.. invece che creare un altro file, posso fare tutto sullo stesso: LocMerce - piazzale?
Anthony47 ha scritto:Non capisco la domanda... Con quanto ti ho proposto non c'e' nessun secondo file da creareLa seconda domanda è.. invece che creare un altro file, posso fare tutto sullo stesso: LocMerce - piazzale?
Anthony47 ha scritto:...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.
Anthony47 ha scritto: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
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
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
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
Per migliorare l'esperienza utente: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?
#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
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
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
Ma nulla impedisce di aggiungere un pulsante per fare la scelta da pulsante e non (solo) all'apertura del file.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).
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
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
Anthony47 ha scritto:Per migliorare l'esperienza utente: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?
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
#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
Anthony47 ha scritto: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
Gianca532011 ha scritto: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
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.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
#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
Declare PtrSafe Sub Sleep
Declare Sub Sleep Lib
#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
Se Caso1 Allora
Fai una cosa
Altrimenti
Fai la stessa cosa
End Se
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
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
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
#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
Anthony47 ha scritto: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
Torna a Applicazioni Office Windows
Creare un file Excel con fogli visibili in base all'accesso Autore: JanVathek |
Forum: Applicazioni Office Windows Risposte: 24 |
HD Esterno collegato con USB non visto in Esplora File Autore: ricky53 |
Forum: Sistemi Operativi Windows Risposte: 13 |
Macro crea file word rinominato come dato in specifica cella Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 11 |
Visitano il forum: Nessuno e 9 ospiti