Titre du sujet : Re: Horloges multiples dans userform
par MARLOT le 05/11/2011 08:47:07
Bonjour Myta
Mon formulaire contient environ une quinzaine de textbox (Etapes de processus que je dois mesurer en cliquant dessus (L'heure s'arrete au click au lieu d'obliger l'utilisateur à rentrer et saisir ces données)
Celles ci sont ensuite récupérées dans une feuille ou d'autres calculs sont encore réalisés (oK j'ai réussi cette étape !!)
Si quelqu'un clique une nouvelle fois sur la même textbox ,logiquement l'heure se met à nouveau à jour par un nouveau click
Pour quittez le formulaire
J'ai crée un bouton "annulez saisie" et "validez saisie"
Les textbox se suivent au niveau de la saisie (Tab )et respectent une certaine chronologie.
J'ai rajouté egalement un chronometre à la main de l'utilisateur (Bouton start /stop/reset pour mesurer certains points
Je te joins déja un extrait du code VBA utilisé et si tu le souhaites le fichier excel complet
Merci beaucoup !
Cordialement
Dim dteStart As Date, dteFinish As Date
Dim dteStopped As Date, dteElapsed As Date
Dim boolStopPressed As Boolean, boolResetPressed As Boolean
Private Sub btnReset_Click()
dteStopped = 0
dteStart = 0
dteElapsed = 0
Label1 = "00:00:00"
boolResetPressed = True
End Sub
Private Sub btnStart_Click()
Start_timer:
dteStart = TIME
boolStopPressed = False
boolResetPressed = False
Timer_Loop:
DoEvents
dteFinish = TIME
dteElapsed = dteFinish - dteStart + dteStopped
If Not boolStopPressed = True Then
Label1 = dteElapsed
If boolResetPressed = True Then GoTo Start_timer
GoTo Timer_Loop
Else
Exit Sub
End If
End Sub
Private Sub btnStop_Click()
boolStopPressed = True
dteStopped = dteElapsed
End Sub
Private Sub cmdAnnuler_Click()
Unload Me
End Sub
Private Sub citypairinbound_Change()
End Sub
Private Sub cnlsaisie_Click()
Unload Me
End Sub
Private Sub CommandButton1_Click()
'---------------------------------------------------------------------------------------
' Auteur : Didier FOURGEOT (myDearFriend!)
' www.mdf-xlpages.com
' Date : 18/06/2006
' Sujet : Horloge Digitale
'---------------------------------------------------------------------------------------
Dim Temps As Date
Public Sub MAJHorloge()
'Programmation de l'évènement toutes les secondes
Temps = Now + TimeValue("00:00:01")
Application.OnTime Temps, "MAJHorloge"
'MAJ de l'horloge
ThisWorkbook.Sheets(1).Shapes("Horloge").TextFrame.Characters.Text = Format(Now, "hh:mm:ss")
End Sub
Public Sub StopHorloge()
On Error Resume Next
'Stoppe la gestion de l'évènement OnTime
Application.OnTime Temps, "MAJHorloge", , False
End Sub
Public Sub GoStop()
Static Go As Boolean
If Not Go Then
MAJHorloge
Go = True
Else
StopHorloge
Go = False
End If
End Sub
Private Sub Datesaisie_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub firstpaxongate_Change()
End Sub
Private Sub flight_Change()
End Sub
Private Sub fueltruckarr_Change()
End Sub
Private Sub impression_Click()
End Sub
Private Sub Workbook_Open()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromGuid _
"{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}", 2, 0
End Sub
Private Sub OptionButton1_Click()
End Sub
Private Sub Label34_Click()
End Sub
Private Sub saisie_Click()
' On teste la saisie de anticall
If anticalloff.Text = "" Then
MsgBox "Vous devez entrer toutes les données le curseur est déja positionné sur les valeurs manquantes !."
anticalloff.SetFocus
Exit Sub
End If
' On teste la saisie de door 1
If door1.Text = "" Then
MsgBox "Vous devez entrer toutes les données le curseur est déja positionné sur les valeurs manquantes !."
door1.SetFocus
Exit Sub
End If
' Mise en place des valeurs saisies
Range("A65536").End(xlUp).Offset(1, 0).Value = Datesaisie
Range("B65536").End(xlUp).Offset(1, 0).Value = Stand
Range("C65536").End(xlUp).Offset(1, 0).Value = app
Range("D65536").End(xlUp).Offset(1, 0).Value = flight
Range("E65536").End(xlUp).Offset(1, 0).Value = sta
Range("F65536").End(xlUp).Offset(1, 0).Value = ata
Range("G65536").End(xlUp).Offset(1, 0).Value = pax
Range("H65536").End(xlUp).Offset(1, 0).Value = nbbagarr
Range("I65536").End(xlUp).Offset(1, 0).Value = std
Range("J65536").End(xlUp).Offset(1, 0).Value = atd
Range("K65536").End(xlUp).Offset(1, 0).Value = paxdep
Range("L65536").End(xlUp).Offset(1, 0).Value = bagdep
Range("M65536").End(xlUp).Offset(1, 0).Value = anticalloff
Range("N65536").End(xlUp).Offset(1, 0).Value = door1
Range("O65536").End(xlUp).Offset(1, 0).Value = paxoff
Range("P65536").End(xlUp).Offset(1, 0).Value = lastpaxoff
Range("Q65536").End(xlUp).Offset(1, 0).Value = fueltrcukarr
Range("R65536").End(xlUp).Offset(1, 0).Value = fueltrcukdep
Range("S65536").End(xlUp).Offset(1, 0).Value = cabin
Range("T65536").End(xlUp).Offset(1, 0).Value = firstpaxongate
Range("U65536").End(xlUp).Offset(1, 0).Value = lastpaxongate
Range("V65536").End(xlUp).Offset(1, 0).Value = firstpaxoncabin
Range("W65536").End(xlUp).Offset(1, 0).Value = lastpaxoffcabin
Range("X65536").End(xlUp).Offset(1, 0).Value = doorclosed
Range("Y65536").End(xlUp).Offset(1, 0).Value = stepsremoved
Range("Z65536").End(xlUp).Offset(1, 0).Value = anticallon
Range("AA65536").End(xlUp).Offset(1, 0).Value = dispatchername
' On place les donnes sur la feuille DONNES
Sheets("DONNES").Range("datesaisie").Value = Datesaisie
Sheets("DONNES").Range("stand").Value = Stand
Sheets("DONNES").Range("app").Value = app
Sheets("DONNES").Range("flight").Value = flight
Sheets("DONNES").Range("STA").Value = sta
Sheets("DONNES").Range("ATA").Value = ata
Sheets("DONNES").Range("PAX").Value = pax
Sheets("DONNES").Range("nbbagarr").Value = nbbagarr
Sheets("DONNES").Range("STD").Value = std
Sheets("DONNES").Range("ATD").Value = atd
Sheets("DONNES").Range("paxdep").Value = paxdep
Sheets("DONNES").Range("bagdep").Value = bagdep
Sheets("DONNES").Range("Anticalloff").Value = anticalloff
Sheets("DONNES").Range("door1").Value = door1
Sheets("DONNES").Range("paxoff").Value = paxoff
Sheets("DONNES").Range("lastpaxoff").Value = lastpaxoff
Sheets("DONNES").Range("fueltrcukarr").Value = fueltrcukarr
Sheets("DONNES").Range("fueltrcukdep").Value = fueltrcukdep
Sheets("DONNES").Range("cabin").Value = cabin
Sheets("DONNES").Range("firstpaxongate").Value = firstpaxongate
Sheets("DONNES").Range("lastpaxongate").Value = lastpaxongate
Sheets("DONNES").Range("firstpaxoncabin").Value = firstpaxoncabin
Sheets("DONNES").Range("lastpaxoffcabin").Value = lastpaxoffcabin
Sheets("DONNES").Range("doorclosed").Value = doorclosed
Sheets("DONNES").Range("stepsremoved").Value = stepsremoved
Sheets("DONNES").Range("anticallon").Value = anticallon
Sheets("DONNES").Range("dispatchername").Value = dispatchername
Unload Me
End Sub
Private Sub UserForm_Initialize()
Label1 = "00:00:00"
End Sub
Sub Test()
End Sub
|
Didier FOURGEOT