Discussion :

[onobyone]

Bonjour tout le monde

J’aurais besoin d’une explication si possible.
J’utilise une base Access pour récupérer des données que j’exporte par la suite dans un fichier Excel créé à partir d’Access (un peu plus de 6000 lignes).
J’ai rajouté du code pour calculer les jours, les et les minutes ouvrées dans le fichier Excel
Tout fonctionne pas de soucis de ce côté-là. Merci les forums
Toutefois, le temps de traitement du calcul des temps est long à partir d’Access alors que sur Excel (avec le même code) est beaucoup plus rapide (pour imager la chose, c'est le jour et la nuit).
Y aurait-il une raison particulière à cela ou est-ce normal du fait que tout se fait à partir d’Access ?
Merci par avance pour votre retour
Bonne journée à vous.
PS : Du fait que tout fonctionne, j'ai estimé qu'il n'était pas nécessaire de mettre le code dans ce post mais si pour une meilleur compréhension vous en auriez besoin, je le mettrais

[loufab]

Bonjour,

Nous ne pratiquons aucun art divinatoire.

Merci de poster le code des 2 cotés : ACCESS et EXCEL.

Ce qui pour les uns peut être considéré comme identique peut ne pas l'être pour les autres.

Cordialement,

[onobyone]

Sans problème.
Je joints les codes.

Le fichier Creation_FichierExcel.txt contient le code qui crée le fichier excel après récupération des données dans la base Access et le met en forme.
Il fait appel au code contenu dans le fichier Calcul_JoursOuvres.txt.

Cordialement
Création du fichier Excel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
Option Compare Database
 
Function FichierExcel()
Dim xlapp As Excel.Application
Set xlapp = Excel.Application
dateextract = Date
 
Date1 = Left(dateextract, 2)
Date2 = Right(Left(dateextract, 5), 2)
Date3 = Right(dateextract, 4)
DateOK = Date1 & "-" & Date2 & "-" & Date3
NomfichierA = "Demandes Habilitations_" & DateOK
 
'Exportaton de la liste des demandes HB
DoCmd.RunSavedImportExport "Exportation-Liste HB"
 
Chemin = "C:\TEMP\"
Fichier = Chemin & "Liste Demandes Habilitations toutes.xlsx"
 
xlapp.Visible = True
xlapp.Workbooks.Open Fichier
xlapp.Sheets("Liste_Demandes_Habilitations_to").Name = "Demandes_Habilitations"
 
'Lancement du calcul des jours, heures, minutes ouvrées
Call JourOuvré
 
DisplayAlerts = False
 
' Mise en forme
        xlapp.Cells.Select
        With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Columns.AutoFit
    Columns("B:F").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("A:A").Select
    xlapp.Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :=".", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1)), TrailingMinusNumbers:=True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:F").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    xlapp.ActiveWorkbook.Worksheets("Demandes_Habilitations").Sort.SortFields.Clear
    xlapp.ActiveWorkbook.Worksheets("Demandes_Habilitations").Sort.SortFields.Add Key:= _
        Range("E2:E3769"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    xlapp.ActiveWorkbook.Worksheets("Demandes_Habilitations").Sort.SortFields.Add Key:= _
        Range("A2:A3769"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Demandes_Habilitations").Sort
        .SetRange Range("A1:Z3769")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    xlapp.Range("A1").Select
 
'MISE EN FORME TABLEAU
'****************************************************************************************
'Besoin de déclarer ces variables pour récupérer le numéro de la dernière ligne sinon
'la mise en forme du tableau ne se fait pas sur toutes les lignes
 
Dim DernLigne As Long
Dim Ligne
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
Ligne = "$A$1:$Z$" & DernLigne
'****************************************************************************************
 
xlapp.ActiveSheet.ListObjects.Add(xlSrcRange, Range(Ligne), , xlYes).Name = _
"Tableau1"
xlapp.Range("A1").Select
 
xlapp.Application.DisplayAlerts = False
 
xlapp.ActiveWorkbook.SaveAs FileName:="C:\TEMP\" + NomfichierA _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
 
'Envoi du fichier
''Call Envoi_Extraction
 
xlapp.Application.DisplayAlerts = True
 
xlapp.ActiveWorkbook.Close
xlapp.Quit
Kill ("c:\temp\Liste Demandes Habilitations toutes.xlsx")
 
Call Message
 
End Function

Calcul des j, h, mn ouvrés :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
Option Compare Database
 
Sub JourOuvré()
Dim DelaiHMN As Long, DelaiMNA As Long
Dim xlapp As Excel.Application
Set xlapp = Excel.Application
 
NbJoursOuvrés = 0
HeureRefDeb = TimeValue("9:00")
HeureRefFin = TimeValue("18:00")
FlagNonOuvré = 0
 
'Parcour mon tab Excel
For p = 2 To Cells(65535, 1).End(xlUp).Row
    'Stock des dates et heures dans variables
    Dt_clos = Format(Range("O" & p).Value, "dd/mm/yy")
    'Si champ vide :
    If Dt_clos = "" Then GoTo suite
    Dt_Ouvert = Format(Range("N" & p).Value, "dd/mm/yy")
    'Si champ vide :
    If Dt_Ouvert = "" Then GoTo suite
    H_Clos = Format(Range("O" & p).Value, "hh:mm")
    H_Ouvert = Format(Range("N" & p).Value, "hh:mm")
    Heures = 1 / 24     '0.041666666667 (N° de série)
    On Error GoTo suite
    datedemande = DateValue(Dt_Ouvert)
    datetraitement = DateValue(Dt_clos)
    HeureDemande = TimeValue(H_Clos)
    HeureTraitement = TimeValue(H_Ouvert)
 
    'Calcul horaire entre heure de la demande et heure du traitement
    TpsHeureTraitement = (HeureRefFin - HeureTraitement) + (HeureDemande - HeureRefDeb)
    If datedemande = datetraitement Then TpsHeureTraitement = TpsHeureTraitement - (9 * Heures)
 
    If TpsHeureTraitement >= (18 * Heures) Then
        TpsHeureTraitement = TpsHeureTraitement - (9 * Heures)
    End If
 
    'on considère que le 1er et dernier jour sont des jours ouvrés
    For i = datedemande + 1 To datetraitement - 1
        If CStr(xlapp.Application.WorksheetFunction.Weekday(i)) Like ("[2-6]") Then
            Call VerifFerié(i, Férié)
            'si on a un jour férié, on le retranche
            NbJoursOuvrés = NbJoursOuvrés + 1 + Férié 'Si férié = true, férié = -1
        End If
    Next
 
    'on vérifie si 1er et dernier jour sont des jours ouvrés
    If Not CStr(xlapp.Application.WorksheetFunction.Weekday(datedemande)) Like ("[2-6]") Then FlagNonOuvré = 1
    If Not CStr(xlapp.Application.WorksheetFunction.Weekday(datetraitement)) Like ("[2-6]") Then FlagNonOuvré = 1
    Call VerifFerié(datedemande, Férié)
    If Férié = True Then FlagNonOuvré = 1
    Call VerifFerié(datetraitement, Férié)
    If Férié = True Then FlagNonOuvré = 1
 
    NbJoursOuvrés = NbJoursOuvrés + Int((24 * TpsHeureTraitement) / 9)
        If TpsHeureTraitement >= (9 * Heures) Then
            TpsHeureTraitement = TpsHeureTraitement - (9 * Heures * (NbreJrs + 1))
        End If
    délaiH = Format(TpsHeureTraitement, "hh:mm")
 
    'MsgBox "Délai d'intervention" & vbCr & "Nbre de jours ouvrés " & NbJoursOuvrés & vbCr & "Nombre d'heures " & délaiH
    DelaiHMN = CStr((NbJoursOuvrés * 9 + Hour(délaiH)) * 60)
    DelaiMNA = CStr(Minute(délaiH))
 
    Cellule_Result = CStr((NbJoursOuvrés * 9 + Hour(délaiH)) & "h") & "-" & CStr(Minute(délaiH) & "mn")
    Cellule_ResultJ = CStr(NbJoursOuvrés)
    Cellule_ResultH = CStr((NbJoursOuvrés * 9 + Hour(délaiH)))
    Cellule_ResultH_MN = DelaiHMN + DelaiMNA
 
    If FlagNonOuvré = 0 Then
        Range("V" & p) = Cellule_Result
        Range("V" & p).NumberFormat = "[h]:mm"
        Range("W" & p) = Cellule_ResultJ
        Range("X" & p) = Cellule_ResultH
        Range("Y" & p) = DelaiMNA
        Range("Z" & p) = Cellule_ResultH_MN
 
        'Range("P" & p).NumberFormat = "[h]:mm"
    Else
        Range("V" & p) = "Jour non ouvré !"
        Range("W" & p) = "Jour non ouvré !"
        Range("X" & p) = "Jour non ouvré !"
        Range("Y" & p) = "Jour non ouvré !"
        Range("Z" & p) = "Jour non ouvré !"
    End If
    NbJoursOuvrés = 0
    délaiH = 0
    FlagNonOuvré = 0
 
suite:
 
    Next p
 
'Mise en forme des colones Date debut et date fin
    Columns("N:N").Select
   xlapp.Selection.NumberFormat = "m/d/yyyy h:mm"
    Columns("O:O").Select
   xlapp.Selection.NumberFormat = "m/d/yyyy h:mm"
    Columns("N:N").EntireColumn.AutoFit
    Columns("O:O").EntireColumn.AutoFit
 
'Ajout des titres de colonnes.
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "DE-Total H-Mn"
    Range("W1").Select
    ActiveCell.FormulaR1C1 = "DE-Nbre J"
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "DE-Nbre H"
    Range("Y1").Select
    ActiveCell.FormulaR1C1 = "DE-Nbre Mn"
    Range("Z1").Select
    ActiveCell.FormulaR1C1 = "DE-Total Mn"
 
    Columns("V:Z").Select
    xlapp.Selection.Columns.AutoFit
    Range("V1").Select
 
xlapp.Workbooks("Liste Demandes Habilitations toutes.xlsx").Activate
 
End Sub
Sub VerifFerié(DateAtraiter, Férié)
    JourFérié = Array("01/01/2014", "21/04/2014", "01/05/2014", "08/05/2014", "29/05/2014", "09/06/2014", _
    "14/07/2014", "15/08/2014", "10/11/2014", "11/11/2014", "25/12/2014", "26/12/2014", _
    "01/01/2015", "02/01/2015", "06/04/2015", "01/05/2015", "08/05/2015", "14/05/2015", "25/05/2015", _
    "13/07/2015", "14/07/2015", "11/11/2015", "25/12/2015") ' etc
 
    For n = 0 To UBound(JourFérié)
        Férié = DateAtraiter = DateValue(JourFérié(n)) ''si vrai, Férié = -1
        If Férié Then Exit For
    Next
End Sub