Calcule heures de nuit 2

Soyez le premier à donner votre avis sur cette source.

Vue 7 399 fois - Téléchargée 889 fois

Description

VOICI ENFIN LA DEUXIÈME VERSION DE MON APPLICATION SUR LE CALCUL D HEURES .J AI CRÉE UN APERÇU ET D AUTRE FONCTION QUI SONT TRÈS UTILE ET TOUS ÇA SANS BASSE ACCES . JE SUIS TOUJOURS EN ATTENTE DE NOTE ET DE CONSEILLE POUR ENCORE AMÉLIORE

Source / Exemple :


Private Sub ajouter_Click()
Dim I As Integer
I = Row + 2
MSFlexGrid1.AddItem Calendar1, 2
MSFlexGrid1.TextMatrix(I, 1) = TxtHeureDebut.Text & " h " & TxtMinuteDebut.Text
MSFlexGrid1.TextMatrix(I, 2) = TxtHeureFin.Text & " h " & TxtMinuteFin.Text
MSFlexGrid1.TextMatrix(I, 3) = TxtHeureResultat.Text & " h " & TxtMinuteResultat.Text
MSFlexGrid1.TextMatrix(I, 4) = Txtohsupp.Text & " h " & Txtomsupp.Text
MSFlexGrid1.TextMatrix(I, 5) = Textheurenuit.Text & " h " & Textminnuit.Text
MSFlexGrid1.TextMatrix(I, 6) = Text1.Text
On Error Resume Next
Text5.Text = Text5.Text
Texthnorm.Text = CSng(TxtHeureResultat.Text) + CSng(Texthnorm.Text)
Text5.Text = CSng(Text5.Text) + CSng(TxtMinuteResultat.Text)
Text8.Text = CSng(Textheurenuit.Text) + CSng(Text8.Text)
Text9.Text = CSng(Textminnuit.Text) + CSng(Text9.Text)
Text6.Text = CSng(Txtohsupp.Text) + CSng(Text6.Text)
Text7.Text = CSng(Txtomsupp.Text) + CSng(Text7.Text)
If Text5.Text > 60 Then Texthnorm.Text = Texthnorm.Text + 1

If Text5.Text > 59 Then Text5.Text = Text5.Text - 60
If Text7.Text > 60 Then Text6.Text = Text6.Text + 1

If Text7.Text > 59 Then Text7.Text = Text7.Text - 60
If Text7.Text < 0 Then Text6.Text = Text6.Text - 1
If Text7.Text < 0 Then Text7.Text = Text7.Text + 60
If Text6.Text < 0 Then Text6.Text = 0
End Sub

Private Sub apercu_Click()
Form2.Show
End Sub

Private Sub calcule_Click()
CalculMinuteFin = TxtMinuteFin
    CalculHeureFin = TxtHeureFin
    
  
    If TxtMinuteFin < TxtMinuteDebut Then
        CalculMinuteFin = TxtMinuteFin + 60
    End If

    If TxtHeureFin < TxtHeureDebut Then
        CalculHeureFin = TxtHeureFin + 24
    End If

    TxtHeureResultat = CalculHeureFin - TxtHeureDebut
    TxtMinuteResultat = CalculMinuteFin - TxtMinuteDebut
     Txtohsupp = TxtHeureResultat - 6
     Txtomsupp = TxtMinuteResultat - 30
   
     Textheurenuit = H2 - TxtHeureDebut
    
    Textminnuit = M2 - TxtMinuteDebut
End Sub

Private Sub effacel_Click()
MSFlexGrid1.Clear
MSFlexGrid1.Rows = 2
MSFlexGrid1.Row = 0
MSFlexGrid1.Col = 0
With MSFlexGrid1
.MergeCells = 1
MSFlexGrid1.MergeRow(1) = True
     .Rows = 2
     .Cols = 7
 .MergeCells = 0
     .MergeRow(0) = True
.ColWidth(0) = 1100
     .ColWidth(1) = 1400
     .ColWidth(2) = 1400
     .ColWidth(3) = 1400
     .ColWidth(4) = 1400
     .ColWidth(5) = 1400
     .ColWidth(6) = 1800
     .TabStop = False
     
     .TextMatrix(0, 0) = "date "
     .TextMatrix(0, 1) = "heure embauche "
     .TextMatrix(0, 2) = "fin de service "
     .TextMatrix(0, 3) = "total jour "
     .TextMatrix(0, 4) = "heure supp "
     .TextMatrix(0, 5) = "heure nuit "
     .TextMatrix(0, 6) = "information "
         End With
End Sub

Private Sub effacetotal_Click()
Texthnorm.Text = "00"
Text5.Text = "00"
Text6.Text = "00"
Text7.Text = "00"
Text8.Text = "00"
Text9.Text = "00"
TxtHeureDebut = "00"
TxtMinuteDebut = "00"
TxtHeureFin = "00"
TxtMinuteFin = "00"
Text2.Clear
End Sub

Private Sub enregistre_Click()
Dim f As Integer
f = FreeFile
Open "apercu.txt" For Output As #f
Print #f, Texthnorm.Text
Close #f
 Dim a As Integer
a = FreeFile
Open "1.txt" For Output As #a
Print #a, Text5.Text
Close #a
Dim b As Integer
b = FreeFile
Open "2.txt" For Output As #b
Print #b, Text6.Text
Close #b
Dim c As Integer
c = FreeFile
Open "3.txt" For Output As #c
Print #c, Text7.Text
Close #c
Dim d As Integer
d = FreeFile
Open "4.txt" For Output As #d
Print #d, Text8.Text
Close #d
Dim e As Integer
e = FreeFile
Open "5.txt" For Output As #e
Print #e, Text9.Text
Close #e
g = FreeFile
Open "MOIS.txt" For Output As #g
Print #g, Text2.Text
Close #g
Dim file_name As String
Dim fnum As Integer
Dim max_row As Integer
Dim max_col As Integer
Dim R As Integer
Dim yy As Integer

    file_name = App.Path
    If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
    file_name = file_name & "FlexGrid1.dat"

    fnum = FreeFile
    Open file_name For Output As fnum

    
    max_row = MSFlexGrid1.Rows - 1
    max_col = MSFlexGrid1.Cols - 1
    Write #fnum, max_row, max_col

    For R = 0 To max_row
        For yy = 0 To max_col
            Write #fnum, MSFlexGrid1.TextMatrix(R, yy);
        Next yy
        Write #fnum,
    Next R

    Close fnum
End Sub

Private Sub fichep_Click()
Form5.Show
End Sub

Private Sub Form_Load()

With MSFlexGrid1
.MergeCells = 1
MSFlexGrid1.MergeRow(1) = True
     .Rows = 2
     .Cols = 7
 .MergeCells = 0
     .MergeRow(0) = True
.ColWidth(0) = 1100
     .ColWidth(1) = 1400
     .ColWidth(2) = 1400
     .ColWidth(3) = 1400
     .ColWidth(4) = 1400
     .ColWidth(5) = 1400
     .ColWidth(6) = 1800
     .TabStop = False
     
     .TextMatrix(0, 0) = "date "
     .TextMatrix(0, 1) = "heure embauche "
     .TextMatrix(0, 2) = "fin de service "
     .TextMatrix(0, 3) = "total jour "
     .TextMatrix(0, 4) = "heure supp "
     .TextMatrix(0, 5) = "heure nuit "
     .TextMatrix(0, 6) = "information "
         End With
          Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    Dim file_name As String
Dim fnum As Integer
Dim max_row As Integer
Dim max_col As Integer
Dim R As Integer
Dim c As Integer
Dim TXT As String
Dim max_len As Single
Dim new_len As Single

    file_name = App.Path
    If Right$(file_name, 1) <> "\" Then file_name = file_name & "\"
    file_name = file_name & "FlexGrid1.dat"

    fnum = FreeFile
    Open file_name For Input As fnum

    
    MSFlexGrid1.Visible = False
    DoEvents

    Input #fnum, max_row, max_col

    MSFlexGrid1.FixedCols = 1
    MSFlexGrid1.Cols = max_col + 1
    MSFlexGrid1.FixedRows = 1
    MSFlexGrid1.Rows = max_row + 1

   
    For R = 0 To max_row
        For c = 0 To max_col
            Input #fnum, TXT
            MSFlexGrid1.TextMatrix(R, c) = TXT
        Next c
Input #fnum, TXT
    Next R

    Close #fnum
    Font.Name = MSFlexGrid1.Font.Name
    Font.Size = MSFlexGrid1.Font.Size
    For c = 0 To max_col
        max_len = 0
        For R = 0 To max_row
            new_len = TextWidth(MSFlexGrid1.TextMatrix(R, c))
            If max_len < new_len Then max_len = new_len
        Next R
        MSFlexGrid1.ColWidth(c) = max_len + 710
        MSFlexGrid1.ColAlignment(c) = flexAlignLeftCenter
    Next c
MSFlexGrid1.Visible = True
    Open App.Path & "\apercu.TXT" For Input As #1
Texthnorm.Text = Input(LOF(1), #1)
Close #1
 Open App.Path & "\1.txt" For Input As #1
Text5.Text = Input(LOF(1), #1)
Close #1
Open App.Path & "\2.txt" For Input As #1
Text6.Text = Input(LOF(1), #1)
Close #1
Open App.Path & "\3.txt" For Input As #1
Text7.Text = Input(LOF(1), #1)
Close #1
Open App.Path & "\4.txt" For Input As #1
Text8.Text = Input(LOF(1), #1)
Close #1
Open App.Path & "\5.txt" For Input As #1
Text9.Text = Input(LOF(1), #1)
Close #1
Open App.Path & "\MOIS.txt" For Input As #1
Text2.Text = Input(LOF(1), #1)
Close #1
    Calendar1.Value = Now
End Sub
Private Sub Option1_Click()
 If Option1.Value = True Then
       Text1.Text = "maladie"
    Else
    If Option2.Value = True Then Option1.Value = False
    
    Text1.Text = "feries"
        If Option3.Value = True Then Option1.Value = False & Option2.Value = False
    Text1.Text = "recuperation"
    End If
     
End Sub

Private Sub Option2_Click()
If Option1.Value = False Then
Text1.Text = "ferie"

End If
End Sub

Private Sub Option3_Click()
If Option3.Value = True Then
Option1.Value = False
Option2.Value = False
    
   Text1.Text = "recuperation"
        
   End If
End Sub

Private Sub Option4_Click()
If Option4.Value = True Then
Option1.Value = False
Option2.Value = False
    Option3.Value = False
    Text1.Text = "normal"
        
   End If
End Sub

Private Sub Option5_Click()
If Option5.Value = True Then
Option1.Value = False
Option2.Value = False
    Option3.Value = False
    Option4.Value = False
    Text1.Text = "congé"
      
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim I As Integer

    For I = Forms.Count - 1 To 1 Step -1
        Unload Forms(I)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
End Sub
Private Sub imprime_Click()
Dim MonImage As StdPicture
Set ObjAppImp = Printer

If COPY = 0 Then COPY = 1
ObjAppImp.Copies = COPY
ObjAppImp.ScaleMode = vbMillimeters
ObjAppImp.CurrentX = 10
ObjAppImp.CurrentY = 20
ObjAppImp.Font = "Arial"
ObjAppImp.FontSize = 12
ObjAppImp.FontItalic = False
ObjAppImp.FontBold = True
ObjAppImp.FontUnderline = True
ObjAppImp.ForeColor = vbBlue
ObjAppImp.Print "EMPLOYE :" & "  " & Form3.nom;

ObjAppImp.CurrentX = 50
ObjAppImp.CurrentY = 50
ObjAppImp.Font = "Courier new"
ObjAppImp.FontUnderline = False
ObjAppImp.FontBold = False
ObjAppImp.ForeColor = vbBlue
ObjAppImp.Print "RELEVER D HEURES DU MOI DE" & "  " & Form1.Text2
ObjAppImp.CurrentX = 110
ObjAppImp.CurrentY = 100
ObjAppImp.Print "Image ICI"

Set MonImage = Form1.MSFlexGrid1.Picture

ObjAppImp.PaintPicture MonImage, 10, 70, 200, 100
ObjAppImp.EndDoc
AfficheApperçu
Set ObjAppImp = Form2.Picture1
End Sub

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

wayne2017
Messages postés
57
Date d'inscription
jeudi 23 février 2017
Statut
Membre
Dernière intervention
10 mai 2017
-
Bonjour

S'il vous plait pouvez vous m'indiquer comment utiliser ce code pour une base de données (ACCESS) car je ne sais pas comment commencer.merci de m'aider
Galactus13
Messages postés
326
Date d'inscription
lundi 29 septembre 2008
Statut
Membre
Dernière intervention
27 juillet 2019
1 -
Salut,
Meilleur présentation, certe,
Mais pourquoi autant de fichier texte !
Un seul réunissant les "variables" dans un fichier ini, aurait suffit,
Pour les options une seule ligne aurait suffit par options!
-> Private Sub Option3_Click()
-> Text1.Text = "recuperation"
-> End Sub
Une autre soluce plus convivial est d'utiliser les Index des boutons Options:
Exemple:
-> Private Sub OptText_Click(Index as integer)
-> Select case Index
-> case 0: Text1.Text = "normal""
-> case 1: Text1.Text = "recuperation"
-> case 2: Text1.Text = "congé"
-> case 3: Text1.Text = "maladie"
-> etc ...
-> end Select
-> End Sub
je n'ai pas décortiquer le reste du code
Mais un peu d'élaguage me semble utile ...
Ca me rapelle mes débuts ! :)
The Meteorologist
Messages postés
234
Date d'inscription
jeudi 18 janvier 2007
Statut
Membre
Dernière intervention
3 novembre 2011
-
Tu n'as pas pris en considération mon premier conseil apparemment ;)
ocejade
Messages postés
55
Date d'inscription
jeudi 26 avril 2007
Statut
Membre
Dernière intervention
6 avril 2015
-
JE DÉSOLÉ POUR LE MODULE 1 JE VOUS LE MET RAPIDEMENT AINSI QU UNE MEILLEUR PRÉSENTATION DEMANDE PAR e The Meteorologist
wayne2017
Messages postés
57
Date d'inscription
jeudi 23 février 2017
Statut
Membre
Dernière intervention
10 mai 2017
> ocejade
Messages postés
55
Date d'inscription
jeudi 26 avril 2007
Statut
Membre
Dernière intervention
6 avril 2015
-
S'il vous plait pouvez vous m'indiquer comment utiliser ce code pour une base de données (ACCESS) car je ne sais pas comment commencer.merci de m'aider

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (ocejade)