Aide erreur écriture VBA
Bonjour,
Je ne comprends pas ce qui ne va pas dans ce codage que vous trouverez ci-après.
Il est censé me calculer les heures du delta tout seul dans la colonne total jour en calculant si la date est la même mais rien ne se produit dans la colonne total jour.
si quelqu'un pouvait m'aider à et me dire d'où provient l'erreur, je lui en serais très reconnaissant :)
Sub PointerDepointer()
Dim Fe As Worksheet
Dim LigDeb As Long
Dim LigFin As Long
Dim i As Integer
Dim TotalSem As Double
Dim TotalJour As Double
Dim Entetes
Const Semaine35Heures As Double = 1.45833333333333 '1 / 24 * 35
Const Journee7Heures As Double = 0.291666666666667 '1 / 24 * 7
Set Fe = Worksheets("heure pointage")
'entêtes des colonnes
Entetes = Array("Date", "Jour", "Heure début", "Heure fin", "Delta", "Total jour", "Total semaine")
With Fe
'inscrit les entêtes et les formate
.Range(.Cells(1, 1), .Cells(1, UBound(Entetes) + 1)).Value = Entetes
.Range(.Cells(1, 1), .Cells(1, UBound(Entetes) + 1)).Font.Bold = True
.Range(.Cells(1, 1), .Cells(1, UBound(Entetes) + 1)).HorizontalAlignment = xlCenter
'sauf les samedis et dimaches
If Weekday(Date, vbMonday) <> 6 And Weekday(Date, vbMonday) <> 7 Then
'défini les lignes pour inscription des dates et heures
LigDeb = .Cells(.Rows.Count, 3).End(xlUp).Row + 1 'sur colonne C
LigFin = .Cells(.Rows.Count, 4).End(xlUp).Row + 1 'sur colonne D
'si la ligne de début (colonne C) est supérieure à la ligne de fin (colonne D) c'est pour un dépointage
If LigDeb > LigFin Then
.Cells(LigFin, 4).Value = Format(Time, "hh:mm") 'inscrit l'heure
.Cells(LigFin, 5).Value = Format(.Cells(LigFin, 4).Value - .Cells(LigFin, 3).Value, "hh:mm") 'calcule le delta en colonne E
'sinon, c'est pour un pointage
Else
.Cells(LigDeb, 1).Value = Date 'inscrit la date
.Cells(LigDeb, 2).Value = Format(Date, "dddd") 'inscrit le jour (lundi, mardi, etc...)
.Cells(LigDeb, 3).Value = Format(Time, "hh:mm") 'inscrit l'heure
End If
'si on est le vendredi
If Weekday(Date, vbMonday) = 5 Then
'boucle sur le tableau
For i = 2 To LigDeb
'si la date de la cellule en cours est la même que la date de la cellule du dessous, commence le total
If .Cells(i, 1).Value = .Cells(i + 1, 1).Value Then
TotalJour = TotalJour + .Cells(i, 5).Value
'sinon, fini le total pour la journée...
Else
TotalJour = TotalJour + .Cells(i, 5).Value
TotalJour = Round(TotalJour, 15)
'inscrit les heures effectuées
.Cells(i, 6).Value = Abs(Journee7Heures - TotalJour)
.Cells(i, 7).NumberFormat = "hh:mm:ss"
'si les 7 heures ne sont pas faites, colore en rouge
If TotalJour < Journee7Heures Then
.Cells(i, 6).Interior.ColorIndex = 4
'si les 7 heures sont faites, pas de couleur
ElseIf TotalJour = Journee7Heures Then
.Cells(i, 6).Interior.ColorIndex = 0
'si plus que les 7 heures, colore en vert
ElseIf TotalJour > Journee7Heures Then
.Cells(i, 6).Interior.ColorIndex = 3
End If
TotalJour = 0
End If
'si la cellule en cours fait partie de la même semaine que la cellule du dessous, commence le total
If DatePart("ww", .Cells(i, 1).Value, 0, 2) = DatePart("ww", .Cells(i + 1, 1).Value, 0, 2) Then
TotalSem = TotalSem + .Cells(i, 5).Value
'sinon, fini le total pour la semaine...
Else
TotalSem = TotalSem + .Cells(i, 5).Value
'inscrit les heures effectuées dans la semaine
.Cells(i, 7).Value = TotalSem
.Cells(i, 7).NumberFormat = "[h]:mm:ss"
'si 35 heures ou plus sont faites, colore en vert
If TotalSem > Semaine35Heures Then
.Cells(i, 7).Interior.ColorIndex = 4
'sinon en rouge
Else
.Cells(i, 7).Interior.ColorIndex = 3
End If
TotalSem = 0
End If
Next i
End If
End If
End With
End SubBonjour Eilime et
Une petite présentation ICI serait la bienvenue
Si vous ne l'avez pas encore fait, je vous invite à lire la charte du forum [A LIRE AVANT DE POSTER]
qui vous aidera dans vos demandes et réponses sur ce forum
A savoir, lorsque vous mettez du code et afin d'une meilleure lisibilité, merci d'utiliser le bouton prévu à cet effet
De plus pour que l'on puisse vous aider correctement, mieux vaut joindre un fichier anonymisé
@+