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
| Private Sub Workbook_Open()
Dim Wb As Workbook
Dim Fichier, chemin As Variant
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim Heures As Integer
Dim Minutes As Integer
Dim Secondes As Integer
chemin = ThisWorkbook.Path & "\"
'Application.ScreenUpdating = False
Debut:
[A2:Z1000].ClearContents
col = Array("", "B", "F", "I", "M", "P", "U", "X", "Z", "AC", "AH", "AI", "AK", "AN")
Fichier = Application.GetOpenFilename("Fichiers .XLS (*.xls),*.xls,Fichier .CSV(*.csv),*.csv")
If Fichier = False Then Exit Sub
Set Wb = GetObject(Fichier)
With Wb.Sheets(1)
lig = .[I14].End(xlDown).Row
For k = 1 To 13
.Range(.Cells(15, col(k)), .Cells(lig + 1000, col(k))).Copy
Cells(2, k).PasteSpecial Paste:=xlPasteValues
Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'suppression ligne vide
lig = [C65000].End(3).Row + 3
Range("A" & lig) = "Amplitude:"
Heures = Left(.[H9], InStr(.[H9], "h") - 1)
Minutes = Mid(.[H9], InStr(.[H9], " ") + 1, InStr(.[H9], "mn") - InStr(.[H9], " ") - 1)
Secondes = Mid(.[H9], InStrRev(.[H9], " ") + 1, InStr(.[H9], "s") - InStrRev(.[H9], " ") - 1)
.[H9] = Format(Heures, "00H") & Format(Minutes, "00m") & Format(Secondes, "00s")
Range("B" & lig) = .[H9]
Range("A" & lig + 1) = "Horamètre:"
For k = 2 To lig - 3
tx = Replace(Range("J" & k), "h ", ":")
tx = Replace(tx, "mn ", ":")
tx = Replace(tx, "s", "")
Range("B" & lig + 1) = Format(Range("B" & lig + 1) + TimeValue(tx), "[h]:mm")
Next
tx = Range("B" & lig + 1)
Range("B" & lig + 1) = Hour(tx) & "H" & Minute(tx) & "m" & Second(tx) & "s"
Range("A" & lig + 2) = "Distance:"
Range("B" & lig + 2) = Replace(.[O11], "Kms", "")
Range("A" & lig + 3) = "Odomètre :"
Range("B" & lig + 3) = Replace(.[H11], "Kms", "")
Range("A" & lig + 4) = "Arrêt:"
Heures = Left(.[W9], InStr(.[W9], "h") - 1)
Minutes = Mid(.[W9], InStr(.[W9], " ") + 1, InStr(.[W9], "mn") - InStr(.[W9], " ") - 1)
Secondes = Mid(.[W9], InStrRev(.[W9], " ") + 1, InStr(.[W9], "s") - InStrRev(.[W9], " ") - 1)
.[W9] = Format(Heures, "00H") & Format(Minutes, "00m") & Format(Secondes, "00s")
Range("B" & lig + 4) = .[W9]
Range("A" & lig + 5) = "Contact:"
Heures = Left(.[O9], InStr(.[O9], "h") - 1)
Minutes = Mid(.[O9], InStr(.[O9], " ") + 1, InStr(.[O9], "mn") - InStr(.[O9], " ") - 1)
Secondes = Mid(.[O9], InStrRev(.[O9], " ") + 1, InStr(.[O9], "s") - InStrRev(.[O9], " ") - 1)
.[O9] = Format(Heures, "00H") & Format(Minutes, "00m") & Format(Secondes, "00s")
Range("B" & lig + 5) = .[O9]
Range("A" & lig + 6) = "Pause:"
Heures = Left(.[W11], InStr(.[W11], "h") - 1)
Minutes = Mid(.[W11], InStr(.[W11], " ") + 1, InStr(.[W11], "mn") - InStr(.[W11], " ") - 1)
Secondes = Mid(.[W11], InStrRev(.[W11], " ") + 1, InStr(.[W11], "s") - InStrRev(.[W11], " ") - 1)
.[W11] = Format(Heures, "00H") & Format(Minutes, "00m") & Format(Secondes, "00s")
Range("B" & lig + 6) = .[W11]
Range("A" & lig + 7) = "Roulage:"
Heures = Left(.[W10], InStr(.[W10], "h") - 1)
Minutes = Mid(.[W10], InStr(.[W10], " ") + 1, InStr(.[W10], "mn") - InStr(.[W10], " ") - 1)
Secondes = Mid(.[W10], InStrRev(.[W10], " ") + 1, InStr(.[W10], "s") - InStrRev(.[W10], " ") - 1)
.[W10] = Format(Heures, "00H") & Format(Minutes, "00m") & Format(Secondes, "00s")
Range("B" & lig + 7) = .[W10]
Range("A" & lig + 8) = "Moy:"
Range("B" & lig + 8) = Replace(.[O10], "Km/h", "")
Range("A" & lig + 9) = "Vit.Max:"
Range("B" & lig + 9) = Replace(.[H10], "Km/h", "")
ActiveSheet.Name = .[D5]
Range("A1:M1").Copy
Range("A1:A" & [A65000].End(xlUp).Row).Value = Range("A1:A" & [A65000].End(xlUp).Row).Value
End With
If MsgBox("Voulez-vous ajouter un autre fichier", vbYesNo + vbExclamation, "Question") = vbYes Then
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
Cells(1, 1).Select
ActiveSheet.Paste
Wb.Close savechanges:=False
GoTo Debut
Else:
Wb.Close savechanges:=False
'recherche dans toutes les feuilles du classeur
For Each Fe In Worksheets
With Fe
Set Plage = Union(.Range(.[F2], .[F65536].End(xlUp)), _
.Range(.[G2], .[G65536].End(xlUp)), _
.Range(.[H2], .[H65536].End(xlUp)), _
.Range(.[J2], .[J65536].End(xlUp)), _
.Range(.[M2], .[M65536].End(xlUp)))
End With
For Each Cel In Plage
'extrait les heures, minutes et secondes
Heures = Left(Cel, InStr(Cel, "h") - 1)
Minutes = Mid(Cel, InStr(Cel, " ") + 1, InStr(Cel, "mn") - InStr(Cel, " ") - 1)
Secondes = Mid(Cel, InStrRev(Cel, " ") + 1, InStr(Cel, "s") - InStrRev(Cel, " ") - 1)
'formate et inscrit dans la cellule
Cel = Format(Heures, "00h") & Format(Minutes, "00m") & Format(Secondes, "00s")
Next Cel
Next Fe
End If
With ActiveWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
ActiveWorkbook.SaveCopyAs (chemin & "SOCIETE-rapport-synthese-periode du DATE.XLS")
ActiveWorkbook.Close savechanges:=False
'Wb.Close
'End Sub
End Sub |
Partager