Excel, VBA, onglet et copier coller
Bonjour à tous les forumeurs, j'ai un problème sur le programme que je suis en train de concevoir, cela se passe sur une badgeuse, dont le programme a pour but de traiter les données, imaginez au départ j'ai ceci :
Entrée Date heure Matricule
0 mercredi 1 juin 2011 08:46 4037
1 mercredi 1 juin 2011 12:28 4037
2 mercredi 1 juin 2011 13:34 4037
3 mercredi 1 juin 2011 17:31 4037
0 mercredi 1 juin 2011 07:10 4127
1 mercredi 1 juin 2011 12:20 4127
2 mercredi 1 juin 2011 13:14 4127
3 mercredi 1 juin 2011 16:44 4127
0 mercredi 1 juin 2011 07:41 4128
1 mercredi 1 juin 2011 12:00 4128
2 mercredi 1 juin 2011 13:55 4128
3 mercredi 1 juin 2011 17:04 4128
1 mercredi 1 juin 2011 13:56 4149
0 mercredi 1 juin 2011 13:56 4149
1 mercredi 1 juin 2011 18:04 4149
0 mercredi 1 juin 2011 08:49 4150
1 mercredi 1 juin 2011 12:03 4150
2 mercredi 1 juin 2011 13:14 4150
3 mercredi 1 juin 2011 17:42 4150
et pour chaque matricule, un onglet doit être crée, et retourner cela :
Date Entrée 1 Sortie 1 Entrée 2 Sortie 2
mercredi 1 juin 2011 12:14:00 13:12:00 17:04:00 16:15:00
lundi 6 juin 2011 12:08:00 13:09:00 17:43:00 16:12:00
mardi 7 juin 2011 08:21:00 12:18:00 13:22:00 17:41:00
mercredi 8 juin 2011 13:15:00 14:23:00 18:27:00 16:12:00
Et comme vous le voyez, tout est décalé, alors oui j'ai le code généraliste, mais je n'ai pas pris en compte le fait que certaines personnes oublieraient de passer a la badgeuse, ce qui cause un immense décalage, et pour compenser cela, je me sens perdu, donc si quelqu'un a idée voici le code :
Sub matricule()
Dim NomEmployer(29) As String
Dim NumereauMatricule(29) As String
Dim K As String
Dim enplacementEmployer(29) 'je ne savais pas comment appeler la variable
NomEmployer(11) = "MAILLE Delphine" ' nom employer et matricule correspondant
NumereauMatricule(11) = 4127
NomEmployer(12) = "ROQUIER Nicolas"
NumereauMatricule(12) = 4164
NomEmployer(13) = "ADAMS-MAYHEW Séverine"
NumereauMatricule(13) = 4145
NomEmployer(14) = "DI GENNARO Dominique"
NumereauMatricule(14) = 4149
NomEmployer(15) = "MONFET Jordan"
NumereauMatricule(15) = 4158
NomEmployer(16) = "BOSSUWE Alice"
NumereauMatricule(16) = 4163
NomEmployer(17) = "POTEREL Alice"
NumereauMatricule(17) = 4171
NomEmployer(18) = "DUPREZ Denis"
NumereauMatricule(18) = 4146
NomEmployer(19) = "BENZIANE Mounia"
NumereauMatricule(19) = 4169
NomEmployer(20) = "ANOUN Carole"
NumereauMatricule(20) = 4173
NomEmployer(21) = "BELMADI Rahmouna"
NumereauMatricule(21) = 4166
NomEmployer(22) = "COURTI Eric"
NumereauMatricule(22) = 1
NomEmployer(23) = "DUPREZ Sandrine"
NumereauMatricule(23) = 4069
NomEmployer(24) = "ELIOT Stéphane"
NumereauMatricule(24) = 4037
NomEmployer(25) = "GAROT Céline"
NumereauMatricule(25) = 1247
NomEmployer(26) = "HASLE Coralie"
NumereauMatricule(26) = 4157
NomEmployer(27) = "LECOSSIER Frédéric"
NumereauMatricule(27) = 4150
NomEmployer(28) = "PEROTIN Laetitia"
NumereauMatricule(28) = 4128
EmployerTotal = 28 'nombre total d'employer
For i = 11 To EmployerTotal
On Error Resume Next 'création des 18 feuilles par rapport à employertotal, pour un employé une feuille de créer
Sheets(NumereauMatricule(i)).Delete
On Error GoTo 0
Sheets.Add
ActiveSheet.Name = NumereauMatricule(i) 'on correspond au nom de la page ,le matricule de l'employé
With ActiveWorkbook.Worksheets(NumereauMatricule(i))
Columns("A:A").Select
Selection.NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
Columns("G:G").ColumnWidth = 14.29
Columns("A:A").ColumnWidth = 22.86
.Range("A11").Value = "Date"
.Range("B11").Value = "entrée 1"
.Range("C11").Value = "sortie 1"
.Range("D11").Value = "entrée 2"
.Range("E11").Value = "sortie 2"
.Range("F11").Value = "Total/jour"
.Range("G11").Value = "Total/semaine"
Columns("I:I").ColumnWidth = 15.29
.Range("A1").Value = "ALEFPA"
.Range("A3").Value = "199/201 RUE COLBERT"
.Range("A5").Value = "T1000 - Etat de fiche de présence"
.Range("A7").Value = NomEmployer(i)
.Range("F7").Value = "numéro de carte : " & NumereauMatricule(i)
.Range("F5").Value = "du 1/05 au 31/05"
.Range("A11:G37").Select
.Range("A37").Value = "Total du mois"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlMedium
End With
End With
Next i 'on passe au rang suivant
Dim j As Integer
Dim l As Integer
j = 12
For i = 10 To EmployerTotal
enplacementEmployer(i) = 12
Next i
matriculePressedent = "0"
While ActiveWorkbook.Worksheets("Feuil1").Cells(j, 1).Value <> "" 'tant qu'il existe une valeur dans la colonne A la boucle continue
For i = 10 To EmployerTotal
If ActiveWorkbook.Worksheets("Feuil1").Cells(j, 4).Value = NumereauMatricule(i) Then
K = NumereauMatricule(i)
m = i
End If
Next i
If matriculePressedent = K And l = 3 Then
l = 4
Else
l = 2
enplacementEmployer(MPressedent) = enplacementEmployer(MPressedent) + 1
End If
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).NumberFormatLocal = "hh:mm:ss"
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 3).Value 'on copie les cellules de la pointeuse vers la nouvelle
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), 1).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 2).Value
l = l + 1
j = j + 1
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).NumberFormatLocal = "hh:mm:ss"
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), l).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 3).Value
ActiveWorkbook.Worksheets(K).Cells(enplacementEmployer(m), 1).Value = ActiveWorkbook.Worksheets("Feuil1").Cells(j, 2).Value
j = j + 1
matriculePressedent = K
MPressedent = m
Wend
End Sub
Bonsoir Colpasus le forum
si tu veux bien m'envoyer un fichier à traiter je regarde cela de plus prêt
par contre STP dans le fichier tu remets les matricules et les noms correspondant
a te relire
a+
papou
Et voici le fichier demandé apres avoir lancé la macro "matricule", comme vous le verrez, quand il manque une entrée, il y a un décalage sur les onglets
-- 29 Juin 2011, 08:47 --
BanzaÏ le principe de ton code est le meme que le mien, mais je voudrais surtout qu'il gere le fait qu'un employer peut oublier une entrée et prenne en compte ce décalage pour que tout le reste ne soit pas atteint.
-- 29 Juin 2011, 10:32 --
Personne pour m'aider ? =(
C'est bon cela fonctionne enfin =D, je te remercie beaucoup Banzai
Non mais je te parlais de celui d'hier, je l'ai retraité pour qu'il fonctionne ^^
je vais voir le plus récent maintenant